perm filename LOADER.MAC[RUT,LSP] blob
sn#343747 filedate 1978-03-22 generic text, type T, neo UTF8
00010 L==1 ;LISP SWITCH ON FOR LISP SYSTEM VERSION
00020 TITLE LOADER V.057
00030 SUBTTL RP GRUEN/NGP/WFW/DMN/WJE 25-MAR-75
00040 ;COPYRIGHT 1968,1969,1970,1971,1972,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
00050
00060 VLOADER==57
00070 VUPDATE==0 ;DEC UPDATE LEVEL
00080 VEDIT==151 ;EDIT LEVEL
00090 VCUSTOM==1 ;NON-DEC UPDATE LEVEL
00100 ;(UCI LISP MODIFICATIONS)
00110
00120 LOC <.JBVER==137>
00130 <VCUSTOM>B2+<VLOADER>B11+<VUPDATE>B17+VEDIT
00140 RELOC
00150
00160 COMMENT * ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)
00170
00180 SWITCHES ON (NON-ZERO) IN DEC VERSION
00190 PURESW GIVES PURE CODE (VARIABLES IN LOW SEG)
00200 REENT GIVES REENTRANT CAPABILITY PDP-10
00210 (REENT=0 FOR PDP-10/30 OR PDP-6 OR EARLY PDP-10)
00220 RPGSW INCLUDE CCL FEATURE
00230 TEMP INCLUDE TMPCOR FEATURE
00240 DMNSW SYMBOL TABLE WILL BE MOVED DOWN FROM TOP OF CORE
00250 KUTSW GIVES CORE CUTBACK ON /K
00260 EXPAND FOR AUTOMATIC CORE EXPANSION
00270 PP ALLOW PROJ-PROG #
00280 NAMESW USE SETNAM UUO TO CHANGE PROGRAM NAME
00290 DIDAL GIVES DIRECT ACCESS LIBRARY SEARCH MODE
00300 ALGSW WILL LOAD ALGOL OWN BLOCK (TYPE 15)
00310 COBSW WILL LOAD COBAL LOCAL SYMBOLS (BLOCK TYPE 37)
00320 SFDSW NUMBER OF SFDS ALLOWED IF NON-ZERO
00330 CPUSW LOADER WILL TEST FOR KI/KA-10 AND LOAD CORRECT LIB40
00340 FORSW DEFAULT VALUE OF FORSE/FOROTS FORTRAN OTS
00350 B11SW INCLUDE POLISH FIXUP BLOCK (TYPE 11)
00360
00370 SWITCHES OFF (ZERO) IN DEC VERSION
00380 K GIVES SMALLER LOADER - NO F4
00390 L FOR LISP LOADER
00400 SPMON GIVES SPMON LOADER (MONITOR LOADER)
00410 MONLOD GIVES MONITOR LOADER WHICH USES DISK AS CORE IMAGE
00420 TEN30 FOR 10/30 LOADER
00430 STANSW GIVES STANFORD FEATURES
00440 LNSSW GIVES LNS VERSION
00450 FAILSW INCLUDE PROVISIONS FOR SPECIAL FAIL FIXUPS.
00460 LDAC MEANS LOAD CODE INTO ACS
00470 (LDAC DOES NOT WORK WITH KUTSW=1.CORE UUO CLEARS JOBBLT)
00480 WFWSW GIVES BLOCK TYPE 13 (VARIABLS INTO LOW SEG)
00490 SYMARG ACCEPT SYMBOLIC (GLOBAL) ARGUMENTS FOR SWITCHES
00500 SPCHN WILL DO SPECIAL OVERLAYING
00510 NELSW FOR NELIAC COMPILER
00520 SAILSW GIVES BLOCK TYPE 16 (FORCE LOAD OF REL FILES)
00530 AND 17 (FORCE SEARCH OF LIBRARIES) FOR SAIL
00540 MANTIS WILL LOAD BLOCK 401 FOR F4 MANTIS DEBUGGER
00550 SYMDSW LOADER WILL STORE SYMBOLS ON DSK
00560 TENEX SPECIAL CODE IF RUNING UNDER TENEX
00570 *
00580 SUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS
00590
00600 IFNDEF SPMON,<SPMON=0>
00610 IFN SPMON,< TEN30==1
00620 K==1>
00630
00640 IFNDEF L,<L=0>
00650
00660 IFNDEF TEN30,<TEN30=0>
00670
00680 IFN TEN30!L,< RPGSW=0
00690 PP=0
00700 IFNDEF DMNSW,< DMNSW=0>
00710 ALGSW=0
00720 COBSW=0
00730 PURESW=0
00740 REENT=0
00750 LDAC=0
00760 KUTSW=0
00770 NAMESW=0>
00780 IFN TEN30,< EXPAND=0
00790 IFNDEF DIDAL,< DIDAL=0>
00800 >
00810
00820 IFN L,< CPUSW==0
00830 PP==1>
00840
00850 IFNDEF MONLOD,<MONLOD=0>
00860 IFN MONLOD,<K==1
00870 ALGSW=0
00880 COBSW=0
00890 DIDAL=0
00900 REENT=0
00910 B11SW==0
00920 SYMDSW==0
00930 EXPAND==1>
00940
00950 IFNDEF K,<K=0>
00960
00970 IFNDEF STANSW,<STANSW=0>
00980 IFN STANSW,< TEMP==0
00990 REENT==0
01000 FAILSW=1>
01010
01020 IFNDEF LNSSW,<LNSSW=0>
01030 IFN LNSSW,<LDAC=1
01040 PP=0>
01050
01060 IFNDEF FAILSW,<FAILSW==0>
01070 IFN FAILSW,<B11SW==1>
01080
01090 IFNDEF B11SW,<B11SW==1>
01100
01110 IFNDEF RPGSW,<RPGSW==1>
01120 IFN RPGSW,<PP==1> ;REQUIRE DISK FOR CCL
01130 IFE RPGSW,<TEMP=0>
01140
01150 IFNDEF PP,<PP==1>
01160
01170 IFNDEF TEMP,<TEMP==1>
01180
01190 IFNDEF NAMESW,<NAMESW==1>
01200
01210 IFNDEF LDAC,<LDAC=0>
01220 IFN LDAC,<KUTSW=0>
01230
01240 IFNDEF KUTSW,<KUTSW==1>
01250
01260 IFNDEF EXPAND,< IFN K,<EXPAND==0>
01270 IFE K,<EXPAND==1>>
01280
01290 IFNDEF DMNSW,<DMNSW==1>
01300 IFN DMNSW!LDAC,<IFNDEF SYMPAT,<SYMPAT==100>
01310 IFN LDAC,<IFG 20-SYMPAT,<SYMPAT==20>>>
01320
01330 IFNDEF REENT,<REENT==1>
01340
01350 IFNDEF PURESW,<PURESW==1>
01360
01370 IFNDEF WFWSW,<WFWSW==0>
01380
01390 IFN K,<SYMARG=0
01400 SPCHN=0>
01410
01420 IFNDEF SYMARG,<SYMARG==0>
01430
01440 IFNDEF SPCHN,<SPCHN==0>
01450
01460 IFNDEF DIDAL,<DIDAL==1>
01470
01480 IFNDEF ALGSW,<ALGSW==1>
01490
01500 IFNDEF COBSW,<COBSW==1>
01510
01520 IFNDEF SAILSW,<SAILSW==0>
01530
01540 IFNDEF NELSW,<NELSW==0>
01550
01560 IFN K,<MANTIS==0>
01570 IFNDEF MANTIS,<MANTIS==0>
01580
01590 IFE PP,<SFDSW==0>
01600 IFNDEF SFDSW,<SFDSW==5>
01610 IFNDEF CPUSW,<CPUSW==1>
01620
01630 IFNDEF FORSW,<FORSW==2> ;1=FORSE, 2=FOROTS
01640
01650 IFNDEF SYMDSW,<SYMDSW==0>
01660 IFN SYMDSW,<DIDAL==0> ;BOTH USE AUX BUFFER
01670 IFNDEF TENEX,<TENEX==0>
01680 SUBTTL ACCUMULATOR ASSIGNMENTS
01690 F=0 ;FLAGS IN BOTH HALVES OF F
01700 N=1 ;FLAGS IN BOTH HALVES OF N
01710 X=2 ;LOADER OFFSET
01720 H=3 ;HIGHEST LOC LOADED
01730 S=4 ;UNDEFINED POINTER
01740 R=5 ;RELOCATION CONSTANT
01750 B=6 ;SYMBOL TABLE POINTER
01760 D=7 ;COMMAND ARGUMENT (OCTAL) AND WORKSPACE
01770 T=10
01780 V=T+1
01790 W=12 ;VALUE
01800 C=W+1 ;SYMBOL, DECIMAL COMMAND ARGUMENT
01810 E=C+1 ;DATA WORD COUNTER
01820 Q=15 ;RELOCATION BITS
01830 A=Q+1 ;SYMBOL SEARCH POINTER
01840 P=17 ;PUSHDOWN POINTER
01850
01860
01870 ;MONITOR LOCATIONS IN THE USER AREA
01880
01890 .JBHDA==10
01900 .JBSDD==114 ;SAVE POINTER TO JOBDDT
01910 .JBS41==122 ;SAVE POINTER TO JOB41
01920
01930 INTERN .JBVER,.JBHDA,.JBSDD,.JBS41
01940 EXTERN .JBDDT,.JBFF,.JBSA,.JBREL,.JBSYM,.JBUSY,.JB41,.JBHRL,.JBCOR
01950 EXTERN .JBCHN,.JBERR,.JBBLT,.JBAPR,.JBDA,.JBHSM
01960
01970 NEGOFF==400 ;NEGATIVE OFFSET OF HIGH SEGMENT
01980
01990
02000 PDLSIZ==40 ;LENGTH OF PUSHDOWN STACK
02010 PPDL==60 ;LENGTH OF PUSHDOWN LIST FOR POLISH FIXUPS
02020 ;FLAGS F(0 - 17)
02030 CSW==1 ;ON - COLON SEEN
02040 ESW==2 ;ON - EXPLICIT EXTENSION IDENT.
02050 SKIPSW==4 ;ON - DO NOT LOAD THIS PROGRAM
02060 FSW==10 ;ON - SCAN FORCED TO COMPLETION
02070 FCONSW==20 ;ON - FORCE CONSOLE OUTPUT
02080 HIPROG==40 ;LOADING HI PROGRAM, SET BY HISEG. CLEARED BY EOF
02090 ASW==100 ;ON - LEFT ARROW ILLEGAL
02100 FULLSW==200 ;ON - STORAGE EXCEEDED
02110 SLIBSW==400 ;ON - LIB SEARCH IN THIS PROG
02120 RMSMSW==1000 ;REMEMBER IF LOADING WITH SYMBOLS DURING LIB SEARCH
02130 REWSW==2000 ;ON - REWIND AFTER INIT
02140 LIBSW==4000 ;ON - LIBRARY SEARCH MODE
02150
02160 ISW==20000 ;ON - DO NOT PERFORM INIT
02170 SYMSW==40000 ;ON - LOAD LOCAL SYMBOLS
02180 DSW==100000 ;ON - CHAR IN IDENTIFIER
02190 NSW==200000 ;ON - SUPPRESS LIBRARY SEARCH
02200 SSW==400000 ;ON - SWITCH MODE
02210
02220
02230
02240 ;MORE FLAGS IN F (18-35)
02250
02260 SEENHI==1 ;HAVE SEEN HI STUFF
02270 NOHI==2 ;LOAD AS NON-REENTRANT
02280 NOTTTY==4 ;DEV "TTY" IS NOT A TTY
02290 NOHI6==10 ;PDP-6 TYPE SYSTEM
02300 HISYM==20 ;BLT SYMBOLS INTO HIGH SEGMENT
02310 SEGFL==40 ;LOAD INTO HI-SEG
02320 XFLG==100 ;INDEX IN CORE (BLOCK TYPE 14)
02330 LSTLOD==200 ;LAST PROG WAS LOADED
02340 DTAFLG==400 ;LIBRARY DEVICE IS A DTA (NEEDED FOR INDEXING)
02350 DMNFLG==1000 ;SYMBOL TABLE TO BE MOVED DOWN
02360 SFULSW==2000 ;PRINTED SYMBOL OVERLAP ONCE ALREADY
02370 ARGFL==4000 ;TREAT $%. AS RADIX-50 CHAR.
02380 TWOFL==10000 ;TWO SEGMENTS IN THIS BINARY FILE
02390 LOCAFL==20000 ;PRINT LOCAL SYMBOLS IN MAP
02400 TTYFL==40000 ;AUX. DEV. IS TTY
02410 TRMFL==100000 ;END OF LOADING SEEN ($ OR /G)
02420 KICPFL==200000 ;HOST CPU IS A KI-10
02430 LSYMFL==400000 ;STORE LOCAL SYMBOLS ON DSK
02440 ;FLAGS N(0 - 17)
02450 ALLFLG==1 ;ON - LIST ALL GLOBALS
02460 ISAFLG==2 ;ON - IGNORE STARTING ADDRESSES
02470 COMFLG==4 ;ON - SIZE OF COMMON SET
02480 IFE K,< F4SW==10 ;F4 IN PROGRESS
02490 RCF==20 ;READ DATA COUNT
02500 SYDAT==40; SYMBOL IN DATA>
02510 IFN MONLOD,<DISW==10 ;DISK IMAGE LOAD IN PROGRESS
02520 WOSW==20 ;WRITE OUT SWITCH, DATA IN WINDOW HAS CHANGED>
02530 SLASH==100 ;SLASH SEEN
02540 IFE K,< BLKD1==200 ;ON- FIRST BLOCK DATA SEEN
02550 PGM1==400 ;ON FIRST F4 PROG SEEN
02560 DZER==1000 ;ON - ZERO SECOND DATA WORD>
02570 EXEQSW==2000 ;IMMEDIATE EXECUTION
02580 DDSW==4000 ;GO TO DDT
02590 RPGF==10000 ;IN RPG MODE
02600 AUXSWI==20000 ;ON - AUX. DEVICE INITIALIZED
02610 AUXSWE==40000 ;ON - AUX. DEVICE ENTERED
02620 PPSW==100000 ;ON - READING PROJ-PROG #
02630 PPCSW==200000 ;ON - READING PROJ #
02640 HSW==400000 ;USED IN BLOCK 11 POLISH FIXUPS
02650
02660 ;MORE FLAGS IN N (18-35)
02670 F4FL==400000 ;FORTRAN (F40) SEEN
02680 COBFL==200000 ;COBOL SEEN
02690 ALGFL==100000 ;ALGOL SEEN
02700 NELFL==40000 ;NELIAC SEEN
02710 PL1FL==20000 ;PL/1 SEEN
02720 BLIFL==10000 ;BLISS-10
02730 SAIFL==4000 ;SAIL
02740 FORFL==2000 ;FORTRAN-10
02750 F10TFL==1000 ;FORTRAN-10 CODE FOR THIS FILE SET NOHI (TEMP)
02760 KI10FL==400 ;KI-10 ONLY CODE
02770 KA10FL==200 ;KA-10 ONLY CODE
02780 MANTFL==100 ;MANTIS SEEN, LOAD SPECIAL DATA
02790 SYMFOR==40 ;SYMSW FORCED SET
02800 MAPSUP==20 ;SUPRESS SYBOL TABLE OUTPUT
02810 CHNMAP==10 ;MAP FOR SPCHN ROOT SEGMENT PRINTED
02820 ATSIGN==4 ;AT SIGN - INDIRECT COMMAND
02830 ENDMAP==2 ;DELAY MAP TO END
02840 VFLG==1 ;DEFAULT LOAD REENTRANT OPERATION SYSTEM
02850
02860 COMFLS==F4FL!COBFL!ALGFL!NELFL!PL1FL!BLIFL!SAIFL!FORFL
02870
02880 DEFINE ERROR (X,Y)<
02890 JSP A,ERRPT'X
02900 XLIST
02910 SIXBIT Y
02920 LIST>
02930
02940 IFN TENEX,<
02950 OPDEF JSYS [104B8]
02960 OPDEF SEVEC [JSYS 204]
02970 OPDEF GEVEC [JSYS 205]
02980 OPDEF GET [JSYS 200]
02990 OPDEF GTJFN [JSYS 20]
03000 OPDEF CIS [JSYS 141]
03010 OPDEF DIR [JSYS 130]
03020 >
03030 IFN PURESW,<TWOSEGMENTS
03040 RELOC 400000>
03050
03060 DSKBIT==200000 ;FOR USE WITH DEVCHR
03070 DTABIT==100 ;DITTO
03080
03090 DISIZE=2000 ;CORE WINDOW SIZE
03100 .RBEST==10 ;ESTIMATED SIZE OF BLOCK (SYMBOL)
03110 .RBALC==11 ;ALLOCATED SIZE OF BLOCK (SYMBOL)
03120 DALLOC==↑D500 ;PREALLOCATE SOME SPACE
03130
03140
03150 DSKBLK==200 ;LENGTH OF DISK BLOCKS
03160 DTABLK==177 ;LENGTH OF DECTAPE BLOCKS (EXCLUDING LINK WORD)
03170 VECLEN==↑D25 ;LENGTH OF VECTOR TABLE FOR OVERLAYS
03180
03190 RELLEN==↑D5 ;#NUMBER OF REL FILES OR LIBRARIES (MUST BE SAME)
03200
03210 ;BUFFER SIZES
03220 TTYL==52 ;TWO TTY BUFFERS
03230 IFNDEF BUFN,<BUFN==2 ;TWO DATA BUFFERS FOR LOAD>
03240 IFE LNSSW,<
03250 BUFL==BUFN*203 ;'BUFN' DTA BUFFERS FOR LOAD
03260 ABUFL==203 ;ONE DTA BUFFER FOR AUX DEV>
03270 IFN LNSSW,<
03280 IFE K,<BUFL==4*203+1>
03290 IFN K,<BUFL==203+1>
03300 ABUFL==2*203+1>
03310
03320 ;CALLI DEFINITIONS
03330
03340 OPDEF RESET [CALLI 0]
03350 OPDEF SETDDT [CALLI 2]
03360 OPDEF DDTOUT [CALLI 3]
03370 OPDEF DEVCHR [CALLI 4]
03380 OPDEF CORE [CALLI 11]
03390 OPDEF EXIT [CALLI 12]
03400 OPDEF UTPCLR [CALLI 13]
03410 OPDEF DATE [CALLI 14]
03420 OPDEF MSTIME [CALLI 23]
03430 OPDEF PJOB [CALLI 30]
03440 OPDEF SETUWP [CALLI 36]
03450 OPDEF REMAP [CALLI 37]
03460 OPDEF GETSEG [CALLI 40]
03470 OPDEF SETNAM [CALLI 43]
03480 OPDEF TMPCOR [CALLI 44]
03490
03500
03510 ASUPPRESS
03520 MLON
03530 SALL
03540 SUBTTL INITIALIZATION
03550 BEG: IFE L,< IFN RPGSW,<
03560 TDZA F,F ;NORMAL START
03570 SETO F, ;CCL START>
03580 SETZM DATBEG ;ZERO FIRST WORD OF DATA STORAGE
03590 MOVE N,[DATBEG,,DATBEG+1]
03600 BLT N,DATEND-1 ;ZERO ENTIRE DATA AREA
03610 IFN RPGSW,< ;IF NO CCL FALL THROUGH TO LD:
03620 JUMPE F,LD ;CCL: IF NORMAL START GO TO LD
03630 RESET ;RESET UUO.
03640 IFN TEMP,<MOVEI F,CTLBUF-1 ;USE CCL BUFFER FOR COMMANDS
03650 HRRM F,CTLIN+1 ;DUMMY UP BYTE POINTER
03660 HRLI F,-200 ;MAKE IT AN IOWD
03670 MOVEM F,TMPFIL+1
03680 MOVSI F,'LOA'
03690 MOVEM F,TMPFIL
03700 MOVE N,[XWD 2,TMPFIL] ;POINTER FOR TMPCOR READ
03710 TMPCOR N, ;READ AND DELETE LOA FILE
03720 JRST RPGTMP ;NO SUCH FILE IN CORE, TRY DISK
03730 IMULI N,5 ;GET CHAR COUNT
03740 ADDI N,1
03750 MOVEM N,CTLIN+2 ;STORE IN BUFFER HEADER
03760 MOVEI N,700 ;BYTE POINTER FOR LOA FILE
03770 HRLM N,CTLIN+1 ;BYTE POINTER NOW COMPLETE
03780 SETOM TMPFLG ;MARK THAT A TMPCOR READ WAS DONE
03790 JRST RPGS3C ;GET BACK IN MAIN STREAM
03800 RPGTMP: ; NOT TMP>
03810 INIT 17,1 ;SET UP DSK FOR COMMAND FILE INPUT.
03820 SIXBIT /DSK/
03830 XWD 0,CTLIN
03840 JRST NUTS ;CAN'T INIT, GET INPUT FROM TTY.
03850 MOVEI F,3
03860 PJOB N, ;GET JOB NUMBER
03870 LUP: IDIVI N,12 ;STRIP OFF LAST DIGIT
03880 ADDI N+1,"0"-40 ;CONVERT TO SIXBIT
03890 LSHC N+1,-6 ;SAVE
03900 SOJG F,LUP ;3 DIGITS YET?
03910 HRRI N+2,'LOA' ;LOADER NAME PART OF FILE NAME.
03920 MOVEM N+2,CTLNAM
03930 MOVSI 'TMP' ;AND EXTENSION.
03940 MOVEM CTLNAM+1
03950 LOOKUP 17,CTLNAM ;FILE THERE?
03960 JRST NUTS ;NO.
03970 INIT 16,1 ;GET SET TO DELETE FILE
03980 SIXBIT /DSK/
03990 0
04000 JRST RPGS3A ;GIVE UP
04010 SETZM CTLNAM+3 ;PUT STUFF BACK AS IT WAS
04020 LOOKUP 16,CTLNAM
04030 JRST RPGS3B
04040 SETZM CTLNAM ;SET FOR RENAME
04050 RENAME 16,CTLNAM
04060 JFCL ;IGNORE FAILURE
04070 RPGS3B: RELEASE 16, ;GET RID OF DEVICE
04080 RPGS3A: ;WE HAVE NOT YET STARTED TO SCAN
04090 ;COMMAND IN FILE.
04100 RPGS3: MOVEI CTLBUF
04110 MOVEM .JBFF
04120 INBUF 17,1 ;SET UP BUFFER.
04130 RPGS3C: TTCALL 3,[ASCIZ /LOADING/] ;PRINT MESSAGE THAT WE ARE STARTING.
04140 SKIPE NONLOD ;CONTIUATION OF COMMAND?
04150 JRST RPGS2 ;YES, SPECIAL SETUP.
04160 CCLCHN: MOVSI N,RPGF ;@ CHAIN FILES CYCLE FROM HERE
04170 JRST CTLSET ;SET UP TTY
04180
04190 RPGS1: PUSHJ P,[TLNE F,ESW ;HERE FROM FOO@ COMMAND, STORE NAME.
04200 JRST LDDT3 ;SAVE EXTENSION.
04210 TLZE F,CSW!DSW ;AS NAME
04220 MOVEM W,DTIN ;STORE AS NAME
04230 SETZM W,DTIN1 ;TRY BLANK EXTENSION FIRST.
04240 JRST LDDT4]
04250 MOVEM 0,SVRPG ;SAVE 0 JUST IN CASE
04260 SETZM NONLOD ;DETERMINE IF CONTINUATION.
04270 MOVEI 0,2(B) ;BY SEEING IF ANY SYMBOLS LOADED.
04280 CAME 0,.JBREL
04290 SETOM NONLOD ;SET TO -1 AND SKIP CALLI
04300 IFN TEMP,<SETZM TMPFLG>
04310 MOVE 0,ILD1
04320 MOVEM 0,RPG1
04330 OPEN 17,OPEN1 ;KEEP IT PURE
04340 JRST [MOVE W,RPG1
04350 JRST ILD5]
04360 LOOKUP 17,DTIN ;THE FILE NAME.
04370 JRST [MOVE 0,SVRPG ;RESTORE AC0=F
04380 TLOE F,ESW ;WAS EXT EXPLICIT?
04390 JRST ILD9 ;YES, DON'T TRY AGAIN.
04400 MOVEM 0,SVRPG ;SAVE AC0 AGAIN
04410 MOVSI 0,(SIXBIT /TMP/) ;TRY TMP INSTEAD
04420 MOVEM 0,DTIN1
04430 PUSHJ P,LDDT4 ;SET UP PPN
04440 JRST .-1] ;TRY AGAIN
04450 JRST RPGS3
04460
04470 RPGS2: MOVSI 0,RPGF ;SET FLAG
04480 IORM 0,F.C+N
04490 TLO N,RPGF
04500 MOVE 0,SVRPG
04510 JRST LD2Q ;BACK TO INPUT SCANNING.
04520
04530 NUTS: TTCALL 3,[ASCIZ /?LOADER command file not found/]
04540 EXIT
04550 >;END OF IFN RPGSW
04560 >;END OF IFE L
04570
04580 LD: ;HERE AFTER INITIALIZATION IF NO CCL
04590 IFN L,< HRRZM 0,LSPXIT
04600 HRRZM W,LSPREL# ;SAVE LISP'S RELOCATION
04610 MOVEI 0,0
04620 HRRZM R,RINITL
04630 RESET>
04640 IFE L,<IFN RPGSW,<
04650 HLLZS .JBERR ;MAKE SURE ITS CLEAR.>
04660 RESET ;INITIALIZE THIS JOB
04670 SETZ N, ;CLEAR N
04680 CTLSET: SETZB F,S ;CLEAR THESE AS WELL
04690 IFN TENEX,<TLO F,SYMSW!RMSMSW ;ASSUME /S
04700 TRO F,DMNFLG ;ASSUME /B
04710 SETZM NLSTGL ;PERMIT LST OF UNDEF. GLOBALS>
04720 HLRZ X,.JBSA ;TOP OF LOADER
04730 HRLI X,V ;PUT IN INDEX
04740 HRRZI H,.JBDA(X) ;PROGRAM BREAK
04750 MOVE R,[XWD W,.JBDA] ;INITIAL RELOCATION>
04760 MOVSI E,'TTY'
04770 DEVCHR E,
04780 TLNN E,10 ;IS IT A REAL TTY?
04790 IFN RPGSW,<JRST [TLNN N,RPGF ;IN CCL MODE?>
04800 EXIT ;NO, EXIT IF NOT TTY
04810 IFN RPGSW,< TRO F,NOTTTY ;SET FLAG
04820 JRST LD1] ;SKIP INIT>
04830 INIT 3,1 ;INITIALIZE CONSOLE
04840 SIXBIT /TTY/
04850 XWD BUFO,BUFI
04860 CALLEX: EXIT ;DEVICE ERROR, FATAL TO JOB
04870 MOVEI E,TTY1
04880 MOVEM E,.JBFF
04890 INBUF 3,1
04900 OUTBUF 3,1 ;INITIALIZE OUTPUT BUFFERS
04910 OUTPUT 3, ;DO INITIAL REDUNDANT OUTPUT
04920 LD1:
04930 IFE L,< HRRZ B,.JBREL ;MUST BE JOBREL FOR LOADING REENTRANT>
04940 IFN L,< MOVE B,.JBSYM ;USED INSTEAD OF JOBREL FOR SYMBOL TABLE FIXUPS>
04950 HRRZM B,HISTRT
04960 SUB B,SE3 ;INITIALIZE SYMBOL TABLE POINTER
04970 CAILE H,1(B) ;TEST CORE ALLOCATION
04980 IFE L,< JRST [HRRZ B,.JBREL;TOP OF CORE
04990 ADDI B,2000 ;1K MORE
05000 CORE B, ;TRY TO GET IT>
05010 EXIT ;INSUFFICIENT CORE, FATAL TO JOB
05020 IFE L,< JRST LD1] ;TRY AGAIN>
05030 IFN EXPAND,<MOVE S,[10,,12] ;CORMAX IN NSWTBL
05040 GETTAB S, ;GET MAX CORE ALLOWED TO A JOB
05050 MOVSI S,1 ;SET TO VERY LARGE
05060 IFN REENT,<HLRZ E,.JBHRL ;BUT DON'T INCLUDE HIGH SEGMENT
05070 SUBI S,1(E) ;IN LOW SEGMENT MAX>
05080 IFE REENT,<SUBI S,1 ;ONE LESS FOR K BOUND>
05090 MOVEM S,ALWCOR ;SAVE IT FOR XPAND TEST>
05100 IFN PURESW,<MOVE S,[XWD HICODE,LOWCOD]
05110 BLT S,LOWCOD+CODLN-1>
05120 IFE L,< MOVS E,X ;SET UP BLT POINTER
05130 HRRI E,1(X)>
05140 IFN L,<MOVS E,H
05150 HRRI E,1(H)>
05160 SETZM -1(E) ;ZERO FIRST WORD
05170 BLT E,(B) ;ZERO CORE UP TO THE SYMBOL AREA
05180 HRRZ S,B ;INITIALIZE UNDEF. POINTER
05190 MOVEM S,NAMPTR ;INITIALIZE PROGRAM NAME POINTER
05200 IFE L,< HRRI R,.JBDA ;INITIALIZE THE LOAD ORIGIN
05210 MOVE E,COMM ;SET .COMM. AS THE FIRST PROGRAM
05220 MOVEM E,1(B) ;STORE IN SYMBOL TABLE
05230 HRRZM R,2(B) ;STORE COMMON ORIGIN>
05240 MOVEI E,F.C ;INITIALIZE STATE OF THE LOADER
05250 BLT E,B.C
05260 MOVE W,[ZBEG,,ZBEG+1]
05270 SETZM ZBEG ;CLEAR START OF INITIALIZED DATA
05280 BLT W,ZEND ;AND THE REST
05290 IFN CPUSW,<
05300 MOVNI W,1 ;-1
05310 AOBJN W,.+1 ;STANDARD TEST
05320 JUMPN W,.+2 ;KA-10 (OR PDP-6)
05330 TRO F,KICPFL ;KI-10>
05340 IFN REENT,<MOVSI W,1
05350 MOVEM W,HVAL1
05360 MOVEM W,HVAL
05370 MOVEM X,LOWX
05380 MOVEM R,LOWR
05390 HRRZI W,1
05400 SETUWP W, ;SETUWP UUO.
05410 TRO F,NOHI6 ;PDP-6 COMES HERE.>
05420 IFN REENT!CPUSW,<
05430 MOVEM F,F.C ;PDP-10 COMES HERE.>
05440 IFN SAILSW,<MOVE W,[XWD -RELLEN-1,LIBFLS-1] ;SET UP POINTERS
05450 MOVEM W,LIBPNT# ;IN THE FORM OF AOBJN WORDS
05460 MOVE W,[XWD -RELLEN-1,PRGFLS-1]
05470 MOVEM W,PRGPNT#>
05480 IFE L,< MOVSI W,254200 ;STORE HALT IN .JB41
05490 MOVEM W,.JB41(X) ;...>
05500 IFN L,< MOVE W,.JBREL
05510 HRRZM W,OLDJR>
05520 IFN B11SW,<MOVEI W,440000 ;SET UP THE SPECIAL BITS OF HEADNUM(ADD+POLISH)
05530 MOVEM W,HEADNM
05540 MOVEI W,PDLOV ;ENABLE FOR PDL OV
05550 MOVEM W,.JBAPR
05560 MOVEI W,200000
05570 CALLI W,16
05580 >
05590 IFN DMNSW,<MOVEI W,SYMPAT
05600 MOVEM W,KORSP>
05610 IFN MONLOD,<IFN PURESW,<
05620 MOVEI W,.RBALC ;NUMBER OF WORDS FOR ENTER
05630 MOVEM W,DIOUT
05640 MOVEI W,DALLOC ;NUMBER OF BLOCKS TO ALLOCATE
05650 MOVEM W,DIOUT+.RBEST>>
05660 IFN SFDSW,<GETPPN W, ;GET USER'S PPN
05670 MOVEM W,MYPPN ;SAVE IT FOR [,,] ETC>
05680 IFN FORSW,<MOVEI W,FORSW-1 ;GET DEFAULT
05690 MOVEM W,FORLIB ;INCASE USER DOESN'T SET IT>
05700 ;LOADER SCAN FOR FILE NAMES
05710
05720 LD2Q: XOR N,F.C+N ;HERE WE STORE THE TWO BITS FOR
05730 AND N,[AUXSWI!AUXSWE,,ENDMAP] ;THE AUX FILE INTO THE
05740 XORM N,F.C+N ;SAVED REGISTER 'N'
05750 MOVSI B,F.C ;RESTORE ACCUMULATORS
05760 BLT B,B
05770 MOVE P,PDLPT ;INITIALIZE PUSHDOWN LIST
05780 SETZM BUFI2 ;CLEAR INPUT BUFFER POINTER
05790 IFE PP,<SETZM ILD1 ;CLEAR INPUT DEVICE NAME>
05800 IFN PP,<MOVSI T,'DSK' ;ASSUME DSK.
05810 MOVEM T,ILD1>
05820 SETZM OLDDEV ;TO MAKE IT GO BACK AFTER /D FOR LIBSR
05830
05840 LD2B: RELEAS 1, ;RELEASE BINARY INPUT DEVICE
05850 IFN PP,<SETZM PPPN ;CLEAR PERMANENT PPN ON EACH NEW LINE>
05860 IFN RPGSW,< TLNE N,RPGF ;NOT IF DOING CCL STUFF
05870 JRST LD2BA>
05880 MOVEI T,"*"
05890 IDPB T,BUFO1 ;OUTPUT ASTERISK TO START INPUT
05900 IFN L,< IDPB T,BUFO1 ;** (EXTRA * FOR LISP)>
05910 OUTPUT 3,
05920 LD2BA: TLZ F,FULLSW+ASW+ISW+CSW+ESW+SKIPSW+SLIBSW+REWSW
05930 LD2BP: TLNE F,LIBSW ;WAS LIBRARY MODE ON?
05940 TLO F,SKIPSW ;YES, NORMAL MODE IS SKIPPING
05950 LD2DD: SETZM DTIN ;CLEAR FILE NAME AFTER , CR-LF, ETC
05960
05970 LD2D: SKIPE W,OLDDEV ;RESET DEVICE IF NEEDED.
05980 CAMN W,ILD1 ;IS IT SAME?
05990 JRST LD2DC ;YES, FORGET IT.
06000 MOVEM W,ILD1
06010 LD2DB: TLZ F,ISW+DSW+FSW+REWSW
06020 LD2DC: IFN PP,<SETZM PPN ;DON'T REMEMBER PPN FROM ONE FILE TO NEXT.>
06030 LD2DA: SETZB W,OLDDEV ;INITIALIZE IDENTIFIER SCAN
06040 MOVEI E,6 ;INITIALIZE CHARACTER COUNTER
06050 MOVE V,LSTPT ;INITIALIZE BYTE POINTER TO W
06060 TLZ F,SSW+DSW+FSW ;LEAVE SWITCH MODE
06070 LD3: IFN RPGSW,<TLNE N,RPGF ;CHECK RPG FEATURE
06080 JRST RPGRD>
06090 SOSGE BUFI2 ;DECREMENT CHARACTER COUNTER
06100 JRST [INPUT 3, ;FILL TTY BUFFER
06110 JRST .-1] ;MAKE SURE NOT A NULL BUFFER
06120 ILDB T,BUFI1 ;LOAD T WITH NEXT CHARACTER
06130 LD3AA: CAIE T,175 ;OLD ALTMOD
06140 CAIN T,176 ;EVEN OLDER ONE
06150 MOVEI T,33 ;NEW ONE
06160 CAIL T,140 ;LOWER CASE?
06170 TRZ T,40 ;CONVERT TO UPPER CASE
06180 MOVE Q,T
06190 HRLM Q,LIMBO ;SAVE THIS CHAR.
06200 MOVSS LIMBO ;AND LAST ONE
06210 IDIVI Q,11 ;TRANSLATE TO 4 BIT CODE
06220 LDB Q,LD8(A) ;LOAD CLASSIFICATION CODE
06230 CAIGE Q,4 ;MODIFY CODE IF .GE. 4
06240 TLNN F,SSW ;MODIFY CODE IF SWITCH MODE OFF
06250 ADDI Q,4 ;MODIFY CLASS. CODE FOR DISPATCH
06260 IFN SYMARG,<CAIL Q,20 ;SKIP UNLESS SECOND FORM OF DISPATCH
06270 JRST LD3AB ;DIFFERENT DISPATCH>
06280 HRRZ A,LD3A(Q) ;LOAD RH DISPATCH ENTRY
06290 CAIL Q,10 ;SKIP IF CORRECT DISPATCH ENTRY
06300 HLRZ A,LD3A-10(Q) ;LOAD LH DISPATCH ENTRY
06310 JRST @A ;JUMP TO INDICATED LOCATION
06320
06330 ;HERE ON ERRORS
06340
06350 LD2C: POP P,(P) ;BACKUP ONE LEVEL
06360 LD2: SETZM SBRNAM ;CLEAR BLOCK TYPE 6 SEEN
06370 IFN RPGSW,<TLNE N,RPGF ;IN CCL MODE
06380 TRNN F,TRMFL ;YES, /G SEEN?>
06390 JRST LD2Q ;NO, START A NEW LINE
06400 IFN RPGSW,<POPJ P, ;AND RETURN>
06410
06420 ;COMMAND DISPATCH TABLE
06430
06440 LD3A: XWD LD3,LD7B ;IGNORED CHAR, BAD CHAR (SWITCH)
06450 XWD LD6A,LD6 ;</> OR <(>, LETTER (SWITCH)
06460 XWD LD5,LD6C ;<:>, DIGIT (SWITCH ARG.)
06470 XWD LD5A,LD6D ;<.>, ESCAPE SWITCH MODE <)>
06480 XWD LD5C,LD7 ;<=> OR <L. ARROW>, BAD CHAR.
06490 XWD LD5B,LD4 ;<,>, ALPHABETIC CHAR.
06500 XWD LD5D,LD4 ;<CR.>, NUMERIC CHAR.
06510 XWD LD5E1,LD7 ;<ALT MODE>, BAD CHAR. <)>
06520 IFN SYMARG,<XWD LD7,LD10 ;BAD CHAR,&>
06530
06540 IFN SYMARG,<
06550 LD3AB: ROT Q,-1 ;CUT Q IN HALF
06560 HRRZ A,LD3A(Q) ;PULL OFF RIGHT HALF OF TABLE ENTRY
06570 JUMPGE Q,@A ;WHICH IS CORRECT FOR EVEN ENTRIES
06580 HLRZ A,LD3A(Q) ;BUT USE LEFT HALF FOR ODD ENTRIES
06590 JRST @A>
06600
06610 IFN RPGSW,<
06620 RPGRD1: MOVNI T,5
06630 ADDM T,CTLIN+2
06640 AOS CTLIN+1
06650 RPGRD: SOSG CTLIN+2 ;CHECK CHARACTER COUNT.
06660 JRST RPGRD2
06670 IBP CTLIN+1 ;ADVANCE POINTER
06680 MOVE T,@CTLIN+1 ;AND CHECK FOR LINE #
06690 TRNE T,1
06700 JRST RPGRD1
06710 LDB T,CTLIN+1 ;GET CHR
06720 JRST LD3AA ;PASS IT ON
06730
06740 RPGRD2:
06750 IFN TEMP,<SKIPE TMPFLG ;TMPCOR UUO READ DONE?
06760 JRST RPGRD3 ;YES, SO SHOULD NEVER GET HERE>
06770 IN 17,0
06780 JRST RPGRD+2
06790 STATO 17,740000
06800 JRST RPGRD3 ;END OF FILE
06810 ERROR ,</ERROR WHILE READING COMMAND FILE!/>
06820 EXIT ;AND GIVE UP
06830
06840 RPGRD3: ERROR ,</END-OF-FILE ON COMMAND FILE!/>
06850 EXIT
06860 >
06870 SUBTTL CHARACTER HANDLING
06880
06890 ;ALPHANUMERIC CHARACTER, NORMAL MODE
06900 LD4: SOJL E,LD3 ;JUMP IF NO SPACE FOR CHAR IN W
06910 CAIGE T,141 ;WORRY ABOUT LOWER CASE LETTERS
06920 SUBI T,40 ;CONVERT FROM ASCII TO SIXBIT
06930 IDPB T,V ;DEPOSIT CHAR OF IDENTIFIER IN W
06940 TLO F,DSW ;SET IDENTIFIER FLAG
06950 JRST LD3 ;RETURN FOR NEXT CHARACTER
06960
06970 ;DEVICE IDENTIFIER DELIMITER <:>
06980
06990 LD5: PUSH P,W ;SAVE W
07000 TLOE F,CSW ;TEST AND SET COLON FLAG
07010 PUSHJ P,LDF ;FORCE LOADING
07020 POP P,W ;RESTORE W
07030 TLNE F,ESW ;TEST SYNTAX
07040 JRST LD7A ;ERROR, MISSING COMMA ASSUMED
07050 JUMPE W,LD2DC ;JUMP IF NULL DEVICE IDENTIFIER
07060 EXCH W,ILD1 ;STORE DEVICE IDENTIFIER
07070 MOVEM W,LSTDEV ;SAVE LAST DEVICE SO WE CAN RESTORE IT
07080 JRST LD2DB ;RETURN FOR NEXT IDENTIFIER
07090
07100 ;FILE NAME EXTENSION IDENTIFIER DELIMITER <.>
07110 LD5A: IFN SYMARG,<
07120 TRNE F,ARGFL ;IS "." SPECIAL
07130 JRST LD4 ;YES,RADIX-50>
07140 TLOE F,ESW ;TEST AND SET EXTENSION FLAG
07150 JRST LD7A ;ERROR, TOO MANY PERIODS
07160 TLZE F,CSW+DSW ;SKIP IF NULL IDENT AND NO COLON
07170 MOVEM W,DTIN ;STORE FILE IDENTIFIER
07180 JRST LD2DC ;RETURN FOR NEXT IDENTIFIER
07190
07200 ;INPUT SPECIFICATION DELIMITER <,>
07210 LD5B:
07220 IFN PP,<TLZE N,PPCSW ;READING PP #?
07230 JRST [
07240 IFN SFDSW,< SKIPN D ;JUST A COMMA SEEN?
07250 HLRZ D,MYPPN ;YES, USE OWN PROJ #>
07260 IFE STANSW,< HRLM D,PPN ;STORE PROJ #
07270 JRST LD6A1 ];GET PROG #>
07280 IFN STANSW,< PUSHJ P,RJUST ;RIGHT JUSTIFY W
07290 HRLM W,PPN ;STORE PROJ NAME
07300 JRST LD2D ];GET PROG NAME>
07310 PUSHJ P,SFDCK ;CHECK FOR SFD DIRECTORY>
07320 SETOM LIMBO ;USED TO INDICATE COMMA SEEN
07330 TLZN F,FSW ;SKIP IF PREV. FORCED LOADING
07340 PUSHJ P,FSCN2 ;LOAD (FSW NOT SET)
07350 JRST LD2BP ;RETURN FOR NEXT IDENTIFIER
07360
07370 LD5B1: TLNE F,ESW ;TEST EXTENSION FLAG
07380 JRST LDDT3 ;EXPLICIT EXTENSION IDENTIFIER
07390 TLZN F,CSW+DSW ;SKIP IF IDENT. OR COLON
07400 POPJ P,
07410 MOVEM W,DTIN ;STORE FILE IDENTIFIER
07420 JRST LDDT2 ;ASSUME <.REL> IN DEFAULT CASE
07430 ;OUTPUT SPECIFICATION DELIMITER <=> OR <LEFT ARROW>
07440 ;OR PROJ-PROG # BRACKETS <[> AND <]>
07450
07460 LD5C:
07470 IFN SPCHN,<CAIN T,"=" ;DO A /= AS SWITCH
07480 TLNN F,SSW
07490 SKIPA
07500 JRST LD6>
07510 IFN RPGSW,<CAIN T,"@" ;CHECK FOR * COMMAND.
07520 JRST RPGS1>
07530 IFN PP,<CAIN T,"[" ;PROJ-PROG #?
07540 JRST [TLO N,PPSW+PPCSW ;SET FLAGS
07550 MOVEM W,PPNW ;SAVE W
07560 MOVEM E,PPNE ;SAVE E
07570 MOVEM V,PPNV ;SAVE V
07580 IFN SFDSW,< SETZM SFD ;USED AS A FLAG>
07590 IFE STANSW,< JRST LD6A2]> ;READ NUMBERS AS SWITCHES
07600 IFN STANSW,< JRST LD2D]>
07610 CAIN T,"]" ;END OF PP #?
07620 JRST [PUSHJ P,RBRA ;PROCESS RIGHT BRACKET
07630 JRST LD3] ;READ NEXT IDENT>
07640 TLOE F,ASW ;TEST AND SET LEFT ARROW FLAG
07650 JRST LD7A ;ERROR, MISPLACED LEFT ARROW
07660 PUSHJ P,LD5B1 ;STORE IDENTIFIER
07670 TLZN F,ESW ;TEST EXTENSION FLAG
07680 MOVSI W,'MAP' ;ASSUME <.MAP> IN DEFAULT CASE
07690 HRRI W,0 ;CLEAR RIGHT HALF OF EXTENSION
07700 CAMN W,['CHN '] ;TEST FOR <.CHN> EXTENSION
07710 MOVSI W,'MAP' ;AND TURN IT BACK TO MAP
07720 IFN MONLOD,<CAMN W,['XPN '] ;IS EXTENSION 'XPN'?
07730 JRST DIOPEN ;YES, OPEN DISK IMAGE FILE>
07740 IFN SYMDSW,<CAMN W,['SYM '] ;IF EXT IS SYM
07750 JRST SYOPEN ;OPEN AUX FOR SYMBOL FILE>
07760 MOVEM W,DTOUT1 ;STORE FILE EXTENSION IDENTIFIER
07770 MOVE W,DTIN ;LOAD INPUT FILE IDENTIFIER
07780 MOVEM W,DTOUT ;USE AS OUTPUT FILE IDENTIFIER
07790 IFN SPCHN,<MOVEM W,CHNENT ;AND FOR SPECAIL CHAINING>
07800 IFN PP,<SKIPN W,PPN ;PROJ-PROG #
07810 MOVE W,PPPN ;TRY PERMANENT ONE
07820 MOVEM W,DTOUT+3 ;...>
07830 MOVE W,ILD1 ;LOAD INPUT DEVICE IDENTIFIER
07840 MOVEM W,LD5C1 ;USE AS OUTPUT DEVICE IDENTIFIER
07850 IFN SPCHN,<SKIPN CHNACB ;ARE WE DOING A SPECIAL CHAIN?
07860 MOVEM W,CHNOUT+1 ;ALLOW HIM TO CHOOSE SP CHAIN DEV>
07870 SKIPN W,LSTDEV ;RESTORE LAST
07880 IFN PP,<MOVSI W,'DSK' ;RESET DEVICE TO DSK>
07890 SETZM LSTDEV ;BUT ONLY ONCE
07900 MOVEM W,ILD1
07910 ;INITIALIZE AUXILIARY OUTPUT DEVICE
07920
07930 IFN SYMDSW,<
07940 TLNN F,LSYMFL ;IGNORE IF ALREADY IN USE
07950 PUSHJ P,AUXINI
07960 JRST LD2DD
07970 AUXINI:>
07980 TRZ F,TTYFL
07990 IFE SYMDSW,<TLZE N,AUXSWI+AUXSWE ;FLUSH CURRENT DEVICE
08000 RELEASE 2, ;...>
08010 MOVE W,LD5C1 ;GET AUX DEVICE
08020 DEVCHR W, ;IS DEVICE A TTY?
08030 TLNE W,10 ;...
08040 TRO F,TTYFL ;YES SET FLAG
08050 TLNE W,(1B4) ;IS IT CONTROLING TTY?
08060 IFE SYMDSW,<JRST LD2DD ;YES, SKIP INIT>
08070 IFN SYMDSW,<POPJ P,>
08080 OPEN 2,OPEN2 ;KEEP IT PURE
08090 JRST ILD5A
08100 TLNE F,REWSW ;REWIND REQUESTED?
08110 UTPCLR 2, ;DECTAPE REWIND
08120 TLZE F,REWSW ;SKIP IF NO REWIND REQUESTED
08130 MTAPE 2,1 ;REWIND THE AUX DEV
08140 MOVEI E,AUX ;SET BUFFER ORIGIN
08150 MOVEM E,.JBFF
08160 OUTBUF 2,1 ;INITIALIZE SINGLE BUFFER
08170 TLO N,AUXSWI ;SET INITIALIZED FLAG
08180 IFN LNSSW,<EXCH E,.JBFF
08190 SUBI E,AUX
08200 IDIV C,E
08210 OUTBUF 2,(C)>
08220 IFE SYMDSW,<JRST LD2DD ;RETURN TO CONTINUE SCAN>
08230 IFN SYMDSW,<POPJ P,>
08240 ;RIGHT SQUARE BRACKET (PROJ-PROG NUMBERS)
08250 IFN PP,<
08260 SFDCK: IFN SFDSW,<
08270 TLNN N,PPSW ;READING PP #?
08280 POPJ P, ;NO
08290 SKIPE SFD ;READING SFD YET?
08300 JRST SFDCK1 ;YES
08310 SKIPN D ;NUMBER SEEN?
08320 HRRZ D,MYPPN ;NO, USE MINE
08330 HRRM D,PPN ;STORE IT
08340 MOVEM X,SFD ;NEED AN AC, SETS SFD NON-ZERO
08350 MOVE X,[-SFDSW,,SFD] ;INITIALIZE POINTER
08360 JRST LD2DA ;GET FIRST SFD
08370
08380 SFDCK1: AOBJP X,SFDER ;ERROR IF TOO MANY SFDS
08390 MOVEM W,(X) ;STORE IN SLOT
08400 JRST LD2DA ;GET NEXT SFD
08410
08420 SFDER: MOVE X,SFD ;RESTORE X
08430 ERROR ,</?TOO MANY SFDS SPECIFIED@/>
08440 JRST LD2
08450
08460 >
08470 RBRA: TLZN N,PPSW ;READING PP #?
08480 POPJ P, ;NOPE, RETURN
08490 TLZE N,PPCSW ;COMMA SEEN?
08500 JRST LD7A ;NOPE, INDICATE ERROR
08510 IFN SFDSW,<SKIPN SFD ;A FULL PATH SPECIFIED?
08520 JRST RBRA1 ;NO
08530 AOBJP X,SFDER ;MUST STORE LAST SFD
08540 MOVEM W,(X)
08550 SETZM 1(X) ;END WITH A ZERO
08560 MOVE X,SFD ;RESTORE X
08570 MOVEI W,SFDADD ;POINT TO SFD PATH
08580 EXCH W,PPN
08590 MOVEM W,SFD ;STORE IN BLOCK
08600 JRST RBRA2 ;CONTINUE
08610 RBRA1:>
08620 IFE STANSW,<HRRM D,PPN ;STASH PROG NUMBER
08630 TLZ F,SSW ;AND TURN OFF SWITCH MODE>
08640 IFN STANSW,<PUSHJ P,RJUST ;RIGHT JUSTIFY W
08650 HRRM W,PPN ;STASH PROG NAME>
08660 MOVE W,PPN ;GET PPN
08670 RBRA2: SKIPN DTIN ;FILE NAME SEEN IN THIS SPEC?
08680 SKIPE PPNW ;OR SOMETHING WAITING IN W?
08690 JRST RBRA3 ;YES, SO WE'VE GOT A FILE NAME SOMEWHERE
08700 MOVEM W,PPPN ;NO , SO MAKE PERMANENT PPN
08710 IFN SFDSW,<MOVE W,[SFD,,PSFD]
08720 BLT W,PSFD+SFDSW ;MOVE FULL PATH
08730 MOVEI W,PSFDAD ;POINT TO IT
08740 SKIPE SFD ;BUT NOT IF IT'S ZERO
08750 MOVEM W,PPPN ;AND STORE>
08760 RBRA3: MOVE W,PPNW ;PICKUP OLD IDENT
08770 MOVE E,PPNE ;RESTORE CHAR COUNT
08780 MOVE V,PPNV ;RESTORE BYTE PNTR
08790 POPJ P, ;TRA 1,4
08800
08810 ;RIGHT JUSTIFY W
08820
08830 IFN STANSW,<
08840 RJUST: JUMPE W,LD7A ;NOTHING TO RIGHT JUSTIFY
08850 TRNE W,77 ;IS W RJUSTED YET?
08860 POPJ P, ;YES, TRA 1,4
08870 LSH W,-6 ;NOPE, TRY AGAIN
08880 JRST .-3 ;...>>
08890
08900 IFN SYMARG,<
08910 ;& SELECTS A SYMBOL RATHER THAN ANUMBER FOR A SWITCH ARGUMENT
08920 ;& MUST ALSO FOLLOW THW SYMBOL; THE FORM IS /&SYMBOL&SWITHCH
08930 LD10: TRC F,ARGFL ;SET OR CLEAR SPECIAL CHARS.
08940 TLCE F,SSW ;IF IN SWITCH MODE, EXIT TO GET IDENTIFIER
08950 JRST LD10B
08960 PUSHJ P,ASCR50 ;IF NOT, REENTER IT, CONVERT IDENTIFIER TO R50
08970 PUSHJ P,SDEF ;AND SEE IF IT EXISTS
08980 JRST LD10A ;YES IT DOES
08990 PUSHJ P,PRQ ;NO, COMPLAIN. OUTPUT ?
09000 PUSHJ P,SPACE ;FOLLOWED BY A SPACE
09010 PUSHJ P,PRNAME ;FOLLOWED BY THIS SYMBOL
09020 ERROR 0,</ DOESN'T EXIST@/>
09030 JRST LD2
09040 LD10A: MOVE D,2(A) ;SET D=VALUE OF SYMBOL AS NUMERIC ARG
09050 TLZ F,DSW!FSW
09060 MOVEI E,6 ;INITIALIZE NEW IDENTIFIER SCAN
09070 MOVE V,LSTPT ;(W IS ALREADY 0)
09080 JRST LD3 ;NOW EAT SWITCH AND CONTINUE PROCESSING COMMAND
09090 LD10B: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION TO MAKE SURE FILE IS LOADED
09100 JRST LD2DA>
09110 SUBTTL CONVERT SYMBOL IN W TO RADIX-50 IN C
09120
09130 IFN SYMARG,<
09140 ;ALSO USES A
09150 ASCR50: MOVEI A,0
09160 R50A: MOVEI C,0
09170 ROTC W,6 ;C IS NEXT SIXBIT CHAR
09180 CAIGE C,20
09190 JRST R50B ;UNDER 20, MAY BE ., $, OR %
09200 CAILE C,31
09210 JRST R50C ;OVER 31
09220 SUBI C,20-1 ;IS NUMBER
09230 R50D: IMULI A,50
09240 ADD A,C
09250 JUMPN W,R50A ;LOOP FOR ALL CHARS
09260 MOVE C,A ;WIND UP WITH CHAR IN C
09270 TLO C,040000 ;MAKE IT GLOBAL DEFINITION
09280 POPJ P,
09290 R50B: JUMPE C,R50D ;OK IF SPACE
09300 CAIE C,16 ;TEST IF .
09310 JRST .+3 ;NO
09320 MOVEI C,45 ;YES
09330 JRST R50D
09340 CAIE C,4 ;SKIP IF $
09350 R50E: MOVEI C,5 ;ASSUME % IF NOTHING ELSE
09360 ADDI C,42
09370 JRST R50D
09380 R50C: CAIGE C,41
09390 JRST R50E ;BETWEEN 31 AND 41
09400 CAILE C,72
09410 JRST R50E ;OVER 72
09420 SUBI C,41-13 ;IS LETTER
09430 JRST R50D>
09440
09450 ;DEFINE PUTS A SYMBOL IN THE UNDEFINED SYMBOL TABLE
09460 ;SO LOADER CAN SCAN LIBRARY AND LOAD PROGRAMS BEFORE THEY ARE REQUESTED
09470 ;THE FORM IS /&SYMBOL# WHERE SYMBOL IS CONVERTED TO RADIX-50
09480 IFN SYMARG,<
09490 DEFINE: PUSHJ P,ASCR50 ;CONVRT TO R-50
09500 MOVEI W,-2(S) ;WHERE SYMBOL WILL GO
09510 CAIG W,(H) ;ENOUGH ROOM
09520 IFN EXPAND,<PUSHJ P,[PUSHJ P,XPAND
09530 TLOA F,FULLSW
09540 JRST POPJM3
09550 POPJ P,]>
09560 IFE EXPAND,<TLO F,FULLSW>
09570 SUB S,SE3 ;ADJUST POINTER
09580 MOVEM C,1(S) ;R-50 SYMBOL
09590 SETZM 2(S) ;VALUE
09600 TLZ F,DSW!SSW ;TURN OFF SWITCHES
09610 TRZ F,ARGFL ; DITTO
09620 TLZN N,SLASH ;IF NOT /&NAME#
09630 JRST LD6A2 ;MUST BE (&NAME#), GET )
09640 JRST LD2D ;CONTINUE TO SCAN
09650 >
09660 SUBTTL TERMINATION
09670 ;LINE TERMINATION <CARRIAGE RETURN>
09680
09690 LD5D:
09700 IFN PP,<PUSHJ P,RBRA ;CHECK FOR UNTERMINATED PP #>
09710 SKIPGE LIMBO ;WAS LAST CHAR. BEFORE CR A COMMA?
09720 TLO F,DSW ;YES ,SO LOAD ONE MORE FILE
09730 PUSHJ P,FSCN ;FORCE SCAN TO COMPLETION
09740 JRST LD2B ;RETURN FOR NEXT LINE
09750
09760 ;TERMINATE LOADING <ALT MODE>
09770
09780 LD5E: JUMPE D,LD5E1 ;ENTER FROM G COMMAND
09790 TLO N,ISAFLG ;AND IGNORE ANY STARTING ADDRESS TO COME
09800 HRRZM D,STADDR ;USE NUMERIC STARTING ADDRESS
09810 LD5E1: PUSHJ P,CRLF ;START A NEW LINE
09820 IFN RPGSW,<TRO F,TRMFL ;INDICATE TERMINATION STAGE
09830 RELEASE 17,0 ;RELEASE COMMAND DEVICE>
09840 IFN MANTIS,<TRNN N,MANTFL ;LOADING MANTIS?
09850 JRST LD5E2 ;NO
09860 IFN KUTSW,<SETOM CORSZ ;DON'T KUT BACK CORE>
09870 IFN DMNSW,<TRZ F,DMNFLG ;OR MOVE SYMBOLS>
09880 LD5E2: >
09890 PUSHJ P,SASYM ;SETUP JOBSA,JOBFF,JOBSYM,JOBUSY
09900 IFE NAMESW,<MOVE W,['LOADER'] ;FINAL MESSAGE>
09910 JUMPL S,.+2 ;UNDEFINED SYMBOLS
09920 SKIPE MDG ;OR MULTIPLY DEFINED
09930 PUSHJ P,PRQ ;PRINT "?" FOR BATCH
09940 IFN NAMESW,<HRRZ W,HISTRT ;IN CASE NO NAME SET, USE FIRST LOADED
09950 MOVE W,-1(W)
09960 SKIPN CURNAM
09970 PUSHJ P,LDNAM
09980 MOVE W,CURNAM
09990 CAME W,[SIXBIT /MAIN/] ;FORTRAN MAIN PROG, OR MACRO NO TITLE
10000 JUMPN W,.+3 ;A USEFUL NAME SEEN
10010 SKIPE PRGNAM ;NO, SO TRY BINARY FILE NAME
10020 MOVE W,PRGNAM ;USE BINARY FILE NAME IN EITHER CASE
10030 IFE L,<MOVEM W,CURNAM ;SAVE NAME FOR LATER>
10040 IFN L,<SETNAM W, ;SETNAM>>
10050 IFN MONLOD,<TLNN N,DISW ;SKIP IF LOADING TO DISK?>
10060 PUSHJ P,BLTSET ;SETUP FOR FINAL BLT
10070 RELEASE 2, ;RELEASE AUX. DEV.
10080 RELEASE 1,0 ;INPUT DEVICE
10090 RELEASE 3,0 ;TTY
10100 IFN SPCHN,<RELEASE 4,0 ;SPECIAL CHAINING CHANEL>
10110 IFN L,< MOVE W,LSPREL ;RESTORE LISP'S RELOCATION
10120 JRST @LSPXIT>
10130 IFE L,< ;NONE OF THIS NEEDED FOR LISP
10140 IFN PURESW,<
10150 MOVE V,[XWD HHIGO,HIGO]
10160 BLT V,HIGONE ;MOVE DOWN CODE TO EXIT>
10170 TLNN N,EXEQSW ;DO WE WANT TO START
10180 JRST LD5E3
10190 IFN RPGSW,<HRRZ C,.JBERR ;CHECK FOR ERRORS
10200 IFE MANTIS,<TLNN N,DDSW ;ALLOW EXECUTION IF TO DDT>
10210 IFN MANTIS,<TDNN N,[DDSW,,MANTFL] ;OR MANTIS>
10220 JUMPN C,EXDLTD ;ERRORS AND NOT TO DDT>
10230 IFN MONLOD,<TLNE N,DISW ;DISK IMAGE LOAD IN PROGRESS?
10240 MOVE X,XRES ;YES, GET RESIDENT X>
10250 HRRZ W,.JBSA(X)
10260 IFN MANTIS,<TRNN N,MANTFL ;NO MESSAGE IF STARTING SPECIAL DEBUGGER>
10270 TLNN N,DDSW ;SHOULD WE START DDT??
10280 IFE TENEX,<JRST LD5E2 ;NO>
10290 IFN TENEX,<JRST LD5E2 ;NO
10300 PUSH P,1
10310 MOVEI 1,400000 ;THIS FORK
10320 DIR
10330 CIS
10340 JSYS 147 ;TENEX RESET, NOT CALLI 0. FLUSH PA1050
10350 MOVE 1,.JBSYM(X)
10360 MOVEM 1,@770001 ;GIVE SYMS TO DDT
10370 MOVE 1,.JBUSY(X)
10380 MOVEM 1,@770002 ;AND UNDEF SYMS
10390 POP P,1>
10400 HRRZ W,.JBDDT(X)
10410 TTCALL 3,[ASCIZ /DDT /]
10420 LD5E2: IFN MANTIS,<
10430 SKIPE V,MNTSYM ;SHOULD WE START SPECIAL DEBUGGER?
10440 TRNN N,MANTFL
10450 JRST .+3 ;NO
10460 HRRZ W,.JBREN##(X) ;YES
10470 MOVEM V,.JBCN6##(X) ;SETUP AUXILARY SYMBOL POINTER>
10480 IFN RPGSW,< TLNE N,RPGF ;IF IN RPG MODE
10490 JUMPE W,NOSTAD ;ERROR IF NO STARTING ADDRESS>
10500 JUMPE W,LD5E3 ;ANYTHING THERE?
10510 TLOA W,(JRST) ;SET UP A JRST
10520 LD5E3: SKIPA W,CALLEX ;NO OR NO EXECUTE, SET CALLI 12
10530 IFN MANTIS,<TRNE N,MANTFL ;NO MESSAGE IF STARTING SPECIAL DEBUGGER
10540 CAIA>
10550 TTCALL 3,[ASCIZ /EXECUTION
10560 /]
10570 IFN TENEX,<MOVEM X,V ;SAVE AWAY RELOCATION
10580 MOVE X,.JBSA(X) ;NEW START ADDRESS
10590 HRLI X,<JRST>B53 ;JRST IN LH
10600 MOVEI N,400000 ;THIS FORK
10610 SEVEC ;SET ENTRY VECTOR
10620 MOVE X,V ;UNSAVE RELOCATION>
10630 IFN LDAC,< HRLZ P,BOTACS ;SET UP FOR ACBLT
10640 MOVEM W,.JBBLT+1(X) ;SET JOBBLT
10650 MOVE W,[BLT P,P]
10660 MOVEM W,.JBBLT(X)>
10670 MOVE V,.JBVER(X) ;GET VERSION NUMBER
10680 MOVEM V,.JBVER ;SET IT UP BEFORE SETNAM UUO
10690 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
10700 JRST DIOVER ;YES, CLEAN UP THE XPN FILE>
10710 TLNE F,FULLSW ;DID WE RUN OUT OF CORE?
10720 HRRZ A,Q ;YES, NULIFY BLT
10730 MOVSI LSTAC,LODACS ;SET UP TO BLT BLT CODE INTO ACS
10740 BLT LSTAC,LSTAC
10750 IFN KUTSW,<SKIPGE E,CORSZ ;DO WE WANT CORE ADJUST
10760 MOVE CORAC,JFCLAC ;NO, CLEAR COREUUO>
10770 IFE LDAC,<MOVE LSTAC,W ;SET END CONDITION>
10780 IFN PURESW,<
10790 MOVSI V,LD ;DOES IT HAVE HISEG
10800 JUMPG V,HINOGO ;NO,DON'T DO CORE UUO
10810 MOVSI V,1 ;SET HISEG CORE NONE ZERO
10820 JRST HIGO ;AND GO>
10830 IFE PURESW,<
10840 IFN NAMESW,<MOVE W,CURNAM ;GET PROGRAM NAME
10850 SETNAM W, ;SET IT FOR VERSION WATCHING>
10860 JRST 0>
10870
10880 LODACS: PHASE 0
10890 BLT Q,(A) ;BLT CODE DOWN
10900 IFN KUTSW,<CORAC:! CORE E, ;CUT BACK CORE
10910 JFCLAC:! JFCL ;SHOULD NEVER HAVE AN ERROR SINCE REDUCING CORE>
10920 SETZB 0,7 ;CLEAR ACCS OTHERWISE USER
10930 SETZB 11,17 ;MIGHT BELIEVE GARBAGE THERE
10940 LSTAC:! IFN LDAC,<JRST .JBBLT>
10950 IFE LDAC,<EXIT>
10960 DEPHASE
10970
10980 IFN RPGSW,<
10990 NOSTAD: TTCALL 3,[ASCIZ /NO STARTING ADDRESS
11000 /]
11010 EXDLTD: TTCALL 3,[ASCIZ /?EXECUTION DELETED
11020 /]
11030 JRST LD5E3>
11040 > ;END OF IFE L AT BEGINNING OF THIS PAGE
00010 SUBTTL PRINT FINAL MESSAGE
00020 ; SET UP BLT AC'S, SETDDT, RELEAS
00030
00040 BLTSET: IFN RPGSW,<IFE K,<
00050 JUMPE W,BLTST3 ;NO MESSAGE FROM CHAIN IN CCL@>>
00060 IFN MANTIS,<TRNE N,MANTFL ;NO MESSAGES IF SPECIAL DEBUGGER
00070 JRST NOMAX>
00080 PUSHJ P,FCRLF ;A RETURN
00090 MOVNI Q,6 ;SET CHARACTER COUNT TO 6
00100 MOVEI D,77 ;CHARACTER MASK
00110 BLTST1: TDNE W,D ;TEST FOR SIXBIT BLANK
00120 JRST BLTST2 ;NO, SO PRINT THE NAME
00130 LSH D,6 ;SHIFT MASK LEFT ONE CHAR
00140 AOJL Q,BLTST1 ;INCR COUNTER & REPEAT
00150 BLTST2: PUSHJ P,PWORD1 ;OUTPUT PROGRAM NAME
00160 PUSHJ P,SPACE
00170 BLTST3:
00180 IFN FAILSW,<MOVSI Q,-20 ;FINISH UP LINK STUFF
00190 FREND: HLRZ V,LINKTB+1(Q)
00200 JUMPE V,NOEND
00210 HRRZ A,LINKTB+1(Q)
00220 IFN REENT,<CAMGE V,HVAL1
00230 SKIPA X,LOWX
00240 MOVE X,HIGHX>
00250 IFN L,<CAML V,RINITL>
00260 HRRM A,@X ;PUT END OF LINK CHAIN IN PROPER PLACE
00270 NOEND: AOBJN Q,FREND
00280 IFN REENT,<MOVE X,LOWX ;RESET THINGS>>
00290 IFN KUTSW,<
00300 SKIPGE C,CORSZ ;NEG MEANS DO NOT KUT BACK CORE
00310 JRST NOCUT
00320 JUMPE C,MINCUT ;0 IS KUT TO MIN. POSSIBLE
00330 LSH C,12 ;GET AS A NUMBER OF WORDS
00340 SUBI C,1
00350 CAMG C,.JBREL ;DO WE NEED MORE THAN WE HAVE??
00360 JRST TRYSML ;NO, SEE IF NUMBER REQUESTED IS TOO SMALL
00370 MOVEI Q,0
00380 CORE Q,
00390 JFCL ;WE JUST WANT TO KNOW HOW MUCH
00400 HRRZS Q
00410 CAMGE Q,CORSZ
00420 JRST CORERR
00430 JRST NOCUT1 ;SET FOR DO NOT CHANGE SIZE
00440 TRYSML: CAIG C,-1(R) ;IS DESIRED AMOUNT BIGGER THAN NEEDED
00450 IFE TENEX,<MINCUT:>
00460 MOVEI C,-1(R) ;GET MIN AMOUNT
00470 IORI C,1777 ;CONVERT TO A 1K MULTIPLE
00480 IFN DMNSW,< TRNN F,DMNFLG ;DID WE MOVE SYMBOLS??
00490 SKIPN .JBDDT(X) ;IF NOT IS DDT THERE??
00500 JRST .+2>
00510 IFE DMNSW,<SKIPE .JBDDT(X) ;IF NO SYMBOL MOVING JUST CHECK DDT>
00520 JRST NOCUT ;DO NOT CUT IF SYMBOLS AT TOP AND DDT
00530 NOCUT1: MOVEM C,.JBREL(X) ;SAVE FOR CORE UUO
00540 MOVEM C,CORSZ ;SAVE AWAY FOR LATER
00550 JRST .+2
00560 NOCUT: SETOM CORSZ ;SET FOR NO CUT BACK>
00570 IFN RPGSW,<IFE K,<
00580 JUMPE W,NOMAX ;NO MESSAGE IF CHAIN IN CCL@>>
00590 IFN L,<HRRZ Q,.JBREL
00600 SUB Q,OLDJR ;PROPER SIZE>
00610 IFE L,<HRRZ Q,.JBREL(X)>
00620 LSH Q,-12 ;GET CORE SIZE TO PRINT
00630 ADDI Q,1
00640 PUSHJ P,RCNUM
00650 IFN REENT,<MOVE Q,HVAL
00660 SUB Q,HVAL1
00670 HRREI Q,-1(Q) ;SIZE IS ONE TOO BIG
00680 CAIG Q,.JBHDA ;IS THERE ANY CODE LOADED THERE?
00690 SETZB Q,HVAL ;NO , CLEAR ALL INDICATIONS OF IT
00700 JUMPE Q,NOHY ;NO HIGH SEGMENT
00710 MOVEI T,"+"-40 ;THERE IS A HISEG
00720 PUSHJ P,TYPE
00730 LSH Q,-12
00740 ADDI Q,1
00750 PUSHJ P,RCNUM
00760 NOHY:>
00770 MOVE W,[SIXBIT /K CORE/]
00780 PUSHJ P,PWORD
00790 IFE L,<
00800 IFN RPGSW,<TLNN N,RPGF
00810 JRST .+4 ;NOT IN CCL MODE SO GIVE ALL INFO
00820 TLZ F,FCONSW ;ONLY PUT ON MAP IF IN CCL MODE
00830 TLNN N,AUXSWI ;IS THERE AN AUX DEV?
00840 JRST NOMESS ;NO, SO SKIP REST OF THIS STUFF>
00850 MOVSI W,', ' ;SET DELIMITER CHARACTERS
00860 MOVNI Q,2 ;SET COUNT TO 2
00870 PUSHJ P,PWORD1 ;OUTPUT THEM
00880 IFN DMNSW,<TRNN F,DMNFLG>
00890 SKIPN .JBDDT(X)
00900 SKIPA Q,.JBREL(X)
00910 MOVEI Q,1(S) ;FIND THE AMOUNT OF SPACE LEFT OVER
00920 SUB Q,.JBFF(X)
00930 ADDI Q,1 ;ONE TWO SMALL
00940 PUSHJ P,RCNUM
00950 IFN REENT,<
00960 SKIPN HVAL ;CREATING A HIGH SEGMENT?
00970 JRST NOHIFR ;NO
00980 MOVEI T,'+' ;YES, TYPE +
00990 PUSHJ P,TYPE
01000 HLRZ Q,.JBHRL(X) ;GET HISEG BREAK
01010 SUBI Q,1 ;1 TOO HIGH (R=NEXT TO LOAD INTO)
01020 ANDI Q,1777 ;CUT TO WORDS FREE
01030 XORI Q,1777
01040 PUSHJ P,RCNUM ;TYPE
01050 NOHIFR:>
01060 MOVE W,[SIXBIT / WORDS/]
01070 PUSHJ P,PWORD
01080 MOVE W,[SIXBIT / FREE/]
01090 PUSHJ P,PWORD
01100 PUSHJ P,CRLF
01110 ERROR 0,</LOADER USED !/> ;GIVE EXPLANATION
01120 MOVE Q,.JBREL
01130 LSH Q,-12
01140 ADDI Q,1
01150 PUSHJ P,RCNUM ;PRINT MAX LOW CORE SIZE
01160 IFN REENT,< SKIPE Q,.JBHRL ;GET SIZE OF HIGH SEGMENT
01170 PUSHJ P,[MOVEI Q,400001(Q) ;CLEAR HIGH ORDER BIT
01180 MOVEI T,"+"-40 ;PRINT A HIGH CORE PART
01190 PUSHJ P,TYPE
01200 LSH Q,-12
01210 JRST RCNUM]>
01220 MOVE W,[SIXBIT /K CORE/]
01230 PUSHJ P,PWORD
01240 NOMESS: TLO F,FCONSW ;FORCE PRINTING OF CRLF>
01250 PUSHJ P,CRLF
01260 IFE L,<
01270 IFN REENT,<HLRZ A,.JBCOR(X) ;GET HIGHEST ACTUAL DATA
01280 CAIL A,.JBDA ;SEE IF GREATER THAN JOBDAT
01290 JRST NOMAX ;YES, SKIP MESSAGE
01300 ERROR 0,</[NULL LOW SEGMENT]!/>
01310 PUSHJ P,CRLF>
01320 NOMAX:
01330 IFE TENEX,<MOVE W,.JBDDT(X)
01340 SETDDT W,
01350 JUMPN W,DDTSET ;DON'T BOTHER IF DDT SET
01360 HLRE Q,.JBSYM(X) ;GET LENGTH OF SYMBOL TABLE
01370 MOVNS Q ;AS POSITIVE NUMBER
01380 HRRZ W,.JBSYM(X) ;GET START
01390 ADD W,Q ;ADDRESS OF HIGHEST LOCATION
01400 HLRZ Q,.JBSA(X) ;HIGHEST LOCATION SAVED BY MONITOR
01410 IFN MANTIS,<TRNN N,MANTFL ;DONT CHECK ADR IF SPECIAL DEBUGGER>
01420 CAIG W,(Q) ;IN BOUNDS?
01430 JRST DDTSET ;YES, ALL OK
01440 IFN REENT,<TRNE F,SEENHI ;ANY HIGH SEGMENT STUFF?
01450 CAMGE W,HVAL1 ;YES, IN HI-SEG THEN?
01460 JRST .+2 ;NO
01470 JRST DDTSET ;YES, ALL IS WELL>
01480 SETZM .JBSYM(X) ;JOBSYM IS OUT OF BOUNDS
01490 CAIA ;JOBUSY ALSO, SO CLEAR THEM>
01500 DDTSET: SKIPLE .JBUSY(X) ;IF ITS NOT A POINTER
01510 SETZM .JBUSY(X) ;DON'T KEEP ADDRESS
01520
01530 IFE TEN30,<HRLI Q,20(X) ;SET UP BLT FOR CODE
01540 HRRI Q,20>
01550 IFN TEN30,<HRLI Q,.JBDDT(X)
01560 HRRI Q,.JBDDT>
01570 >;END OF IFE L
01580 HRRZ A,R
01590 POPJ P, ;WE HAVE SET R UP BY CLEVER CODE IN SASYM
01600 IFN KUTSW,<CORERR: TTCALL 3,[ASCIZ /?NOT ENOUGH CORE
01610 /]
01620 EXIT>
01630
01640 IFN TENEX,<
01650 ;SETUP TO CUT BACK CORE TO MINIMUM
01660 ;THIS IS MIN OF R AND TOP OF SYMTAB
01670 MINCUT: HLRE C,.JBSYM(X)
01680 MOVNS C
01690 ADD C,.JBSYM(X)
01700 HRRZS C
01710 JRST TRYSML ;GO COMPARE WITH R
01720 >
00010 SUBTTL SET UP JOBDAT
00020 SASYM: TLNN F,NSW
00030 PUSHJ P,LIBF ;SEARCH LIBRARY IF REQUIRED
00040 PUSHJ P,FSCN ;FORCE END OF SCAN
00050 IFN ALGSW,<MOVE C,[RADIX50 44,%OWN]
00060 MOVE W,%OWN ;GET VALUE
00070 TRNE N,ALGFL ;IF ALGOL PROG LOADED
00080 PUSHJ P,SYMPT ;DEFINE %OWN
00090 IFN REENT,<MOVE X,LOWX ;MAKE SURE X IS CORRECT>>
00100 IFN RPGSW,<HLRE A,S
00110 MOVNS A
00120 LSH A,-1
00130 ADD A,.JBERR
00140 HRRM A,.JBERR>
00150 IFN SYMDSW,<PUSHJ P,READSYM ;READ BACK LOCAL SYMBOLS>
00160 IFN SPCHN,<
00170 SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
00180 TRNN N,CHNMAP ;TEST FOR ROOT SEGMENT PRINTED
00190 JRST NOCHMP ;JUMP IF NO TO EITHER CONDITION
00200 SETZM LINKNR ;CLEAR OVERLAY LINK NUMBER
00210 MOVE A,BEGOV ;GET START OF OVERLAY POINT
00220 IFN REENT,<ADDI A,(X) ;PLUS LOADER CORE BASE
00230 HRRZS A ;CLEAR LEFT HALF OF REGISTER
00240 HRRZ W,HILOW ;GET CURRENT SPOT IN LOW SEGMENT>
00250 IFE REENT,<HRRZ W,R ;GET CURRENT SPOT IN LOW SEGMENT>
00260 CAMN W,R ;TEST FOR ADDED MODULES
00270 TRZ N,ENDMAP ;NO, THEN SUPRESS MAP AT END
00280 NOCHMP: > ;END OF IFN SPCHN
00290 TRNE N,ENDMAP ;WANT MAP AT END?
00300 PUSHJ P,PRTMAP ;YES
00310 TLNN N,AUXSWE ;TEST FOR MAP PRINTED YET
00320 TLZ N,AUXSWI ; NO, THEN DON'T START NOW
00330 TRNN N,ENDMAP ;DON'T PRINT UNDEFS TWICE
00340 PUSHJ P,PMS ;PRINT UNDEFS
00350 HRRZ A,H ;DO NOT CLOBBER H IF STILL INSERTING SYMBOLS
00360 IFN MONLOD,<TLNN N,DISW ;SKIP IF LOADING TO DISK>
00370 SUBI A,(X) ;HIGHEST LOC LOADED INCLUDES LOC STMTS
00380 CAILE A,(R) ;CHECK AGAINST R
00390 HRR R,A ;AND USE LARGER
00400 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00410 MOVE X,XRES ;YES, GET RESIDENT OFFSET>
00420 IFE L,< HRRZ A,STADDR ;GET STARTING ADDRESS
00430 HRRM A,.JBSA(X) ;STORE STARTING ADDRESS
00440 HRRZM R,.JBFF(X) ;AND CURRENT END OF PROG
00450 HRLM R,.JBSA(X)>
00460 IFN DMNSW,<MOVE C,[RADIX50 44,PAT..] ;MARK PATCH SPACE FOR RPG
00470 MOVEI W,(R)
00480 PUSHJ P,SYMPT
00490 IFN REENT,<TRNE F,HISYM ;SHOULD SYMBOLS GO IN HISEG?
00500 JRST BLTSYM ;YES>>
00510 IFN DMNSW!LDAC,< ;ONLY ASSEMBLE IF EITHER SET
00520 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00530 JRST SASYM1 ;YES, NO NEED TO EXPAND CORE>
00540 IFE LDAC,< TRNN F,DMNFLG ;GET EXTRA SPACE IF SYMBOLS
00550 JRST NODDT ;MOVED OR IF LOADING ACS>
00560 IFE DMNSW,< MOVEI A,20 ;FOR LOADING ACS>
00570 IFN DMNSW,< MOVE A,KORSP
00580 IFN LDAC,< TRNN F,DMNFLG ;ONLY 20 IF SYMBOLS NOT MOVED
00590 MOVEI A,20>>
00600 ADDI A,(R) ;GET ACTUAL PLACE TO PUT END OF SPACE
00610 ADDI A,(X)
00620 CAIL A,(S) ;DO NOT OVERWRITE SYMBOLS
00630 IFN EXPAND,<JRST [PUSHJ P,XPAND>
00640 PUSHJ P,MORCOR
00650 IFN EXPAND,< JRST .-1]>
00660 IFN LDAC,<HRRM R,BOTACS ;SAVE BOTTOM OF WHERE WE PUT ACS
00670 HRRZ A,R
00680 ADDI A,(X)
00690 HRL A,X ;SET UP BLT FROM (X) TO R(X)
00700 MOVEI Q,17(A)
00710 BLT A,(Q)>>
00720 IFN DMNSW,<TRNN F,DMNFLG ;NOW THE CODE TO MOVE SYMBOLS
00730 JRST NODDT
00740 IFN MONLOD,<SASYM1:>
00750 HRRZ A,R
00760 ADD A,KORSP
00770 MOVE W,A ;SAVE POINTER TO FINAL LOC OF UNDEFS
00780 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00790 PUSHJ P,DISYM ;YES, GET BREAK ADDRESS INTO CORE>
00800 ADDI A,(X)
00810 HLLZ Q,S ;COMPUTE LENGTH OF SYMBOL TABLE
00010 ADD Q,B
00020 HLROS Q
00030 MOVNS Q
00040 ADDI Q,-1(A) ;GET PLACE TO STOP BLT
00050 HRLI A,1(S) ;WHERE TO BLT FROM
00060 SUBI W,1(S) ;GET AMOUNT TO CHANGE S AND B BY
00070 BLT A,(Q) ;MOVE SYMBOL TABLE
00080 ADD S,W
00090 ADD B,W ;CORRECT S AND B FOR MOVE
00100 HRRI R,1(Q) ;SET R TO POINT TO END OF SYMBOLS
00110 IFN REENT,<HRRM R,HILOW ;SAVE THIS AS HIGHEST LOC IN LOW SEG TO SAVE>
00120 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00130 MOVE X,XCUR ;GET CURRENT BUFFER OFFSET>
00140 SUBI R,(X)
00150 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00160 MOVE X,XRES ;SET UP OFFSET FOR RESIDENT PORTION>
00170 HRRM R,.JBFF(X)
00180 HRLM R,.JBSA(X) ;AND SAVE AWAY NEW JOBFF
00190 IFE REENT,<HRRM R,.JBCOR(X) ;DON'T LOSE LOW SEGMENT DATA>
00200 IFN LDAC,<SKIPA> ;SKIP THE ADD TO R
00210 NODDT:>
00220 IFN LDAC,<ADDI R,20> ;MAKE SURE R IS CORRECT FOR BLT
00230 MOVE A,B
00240 ADDI A,1 ;SET UP JOBSYM, JOBUSY
00250 IFE L,<MOVEM A,.JBSYM(X)
00260 IFN REENT,<TRNN A,(1B0) ;SYMBOL TABLE IN HIGH SEGMENT?
00270 JRST NOHYSM ;NO
00280 EXCH X,HIGHX ;RELOCATE TO HIGH SEG.
00290 ADD X,HVAL1 ;ADD IN BASE OF HIGH SEGMENT
00300 MOVEM A,.JBHSM(X) ;SINCE MAY NOT START AT 400000
00310 SUB X,HVAL1 ;BACK AS IT WAS
00320 EXCH X,HIGHX
00330 NOHYSM: >>
00340 IFN L,<MOVEM A,.JBSYM>
00350 MOVE A,S
00360 ADDI A,1
00370 IFE L,<MOVEM A,.JBUSY(X)
00380 MOVE A,HISTRT ;TAKE POSSIBLE REMAP INTO ACCOUNT
00390 IFN MANTIS,<TRNE N,MANTFL ;SPECIAL DEBUGGER?
00400 MOVE A,.JBREL ;YES, USE OUR SEGTOP>
00410 MOVEM A,.JBREL(X) ;SET UP FOR IMEDIATE EXECUTION>
00420 IFN L,<MOVEM A,.JBUSY>
00430 IFN MONLOD,<TLNN N,DISW ;LOADING TO DSK?
00440 JRST NOTDSK ;NO
00450 MOVE A,.JBDDT(X) ;GET DDT STARTING ADDRESS
00460 MOVEM A,.JBSDD(X) ;SO GET WILL RESTORE IT
00470 MOVE A,.JB41(X) ;MAY AS WELL SET UP JOB41
00480 MOVEM A,.JBS41(X) ;ALSO
00490 NOTDSK:>
00500 IFN REENT,<
00510 SKIPE A,HILOW ;SET UP TOP LOC OF LOW CORE EXCLUDING BLOCKS
00520 SUBI A,1(X) ;IF NON-ZERO THEN IT NEEDS RELOCATION
00530 HRLM A,.JBCOR(X)
00540 TRNN F,SEENHI
00550 POPJ P,
00560 HRRZ A,HVAL
00570 HRRM A,.JBHRL(X)
00580 SUB A,HVAL1
00590 IFN DMNSW,<TRNE F,HISYM ;SYMBOLS IN HISEG?
00600 ADDI A,1 ;YES, AT TOP OF CORE ALREADY
00610 ;BUT HVAL ONE TOO SMALL>
00620 HRLM A,.JBHRL(X)>
00630 POPJ P,
00640
00010 SUBTTL BLT SYMBOL TABLE INTO HIGH SEGMENT
00020 IFN DMNSW&REENT,<
00030 BLTSYM: MOVE Q,HVAL ;GET ORIGIN OF HISEG
00040 CAMN Q,HVAL1 ;HAS IT CHANGED?
00050 JRST NOBLT ;NO
00060 HLLZ Q,S ;COMPUTE LENGTH OF SYMBOL TABLE
00070 HLRS S ;PUT NEG COUNT IN BOTH HALVES
00080 JUMPE S,.+2 ;SKIP IF S IS ZERO
00090 HRLI S,-1(S) ;SUB 1 FROM LEFT TO FIX CARRY PROBLEM
00100 ADD Q,B
00110 HLROS Q
00120 MOVNS Q
00130 ADD Q,HVAL ;ADD LENGTH OF HISEG
00140 SUB Q,HVAL1 ;BUT REMOVE ORIGIN
00150 ADD Q,HISTRT ;START OF HISEG IN CORE
00160 HRRZS Q ;CLEAR INDEX FROM Q
00170 ADD Q,KORSP ;SAVE SPACE FOR SYMBOL PATCHES
00180 CORE Q, ;EXPAND IF NEEDED
00190 PUSHJ P,MORCOR
00200 PUSH P,B ;SAVE B
00210 SOJ B, ;REMOVE CARRY FROM ADD TO FOLLOW
00220 MOVSS B ;SWAP SYMBOL POINTER
00230 ADD B,.JBREL
00240 HRRM B,(P) ;SAVE NEW B
00250 MOVE Q,.JBREL
00260 ADD B,S ;INCASE ANY UNDEFS.
00270 BLT B,(Q) ;MOVE SYMBOLS
00280 POP P,B ;GET NEW B
00290 SUB B,HISTRT
00300 ADD B,HVAL1
00310 SOJ B, ;REMOVE CARRY
00320 ADDI S,(B) ;SET UP .JBUSY
00330 BLTSY1: MOVE Q,.JBREL
00340 SUB Q,HISTRT
00350 ADD Q,HVAL1
00360 SUBI Q,1 ;ONE TOO HIGH
00370 MOVEM Q,HVAL
00380 JRST NODDT
00390
00010 NOBLT: HRRZ Q,H ;GET HIGHEST LOC LOADED
00020 IORI Q,1777 ;MAKE INTO A K BOUND
00030 MOVEI A,-.JBHDA(S) ;GET BOTTOM OF UNDF SYMBOLS
00040 SUB A,KORSP ;DON'T FORGET PATCH SPACE
00050 CAIG A,(Q) ;ARE THEY IN SAME K
00060 IFN EXPAND,<JRST [PUSHJ P,XPAND>
00070 PUSHJ P,MORCOR
00080 IFN EXPAND,< JRST NOBLT]>
00090 MOVEM Q,HISTRT ;SAVE AS START OF HIGH
00100 MOVEI A,400000 ;HISEG ORIGIN
00110 MOVEM A,HVAL1 ;SAVE AS ORIGIN
00120 SUB S,HISTRT ;GET POSITION OF UNDF POINTER
00130 ADDI S,377777 ;RELATIVE TO ORG
00140 SUB B,HISTRT ;SAME FOR SYM POINTER
00150 ADDI B,377777
00160 SUBI Q,377777
00170 MOVEM Q,HIGHX ;SO WE CAN SET HIGH JOB DATA AREA
00180 TRO F,SEENHI ;SO JOBHRL WILL BE SET UP
00190 JRST BLTSY1 ;AND USE COMMON CODE
00200 >
00210
00220 IFN DMNSW!LDAC!MANTIS!SYMDSW,<
00230 MORCOR: ERROR ,</MORE CORE NEEDED#/>
00240 EXIT>
00010 SUBTTL READ BACK LOCAL SYMBOLS
00020 IFN SYMDSW,<
00030 READSYM:
00040 TRZN F,LSYMFL ;DID WE WRITE A SYMBOL FILE?
00050 POPJ P, ;NO
00060 RELEASE 2, ;CLOSE IT OUT
00070 MOVE W,SYMNAM ;GET NAME
00080 MOVEM W,DTIN
00090 TRNE N,ENDMAP ;MAP STILL REQUIRED?
00100 PUSHJ P,AUXINI ;YES, RE-INIT AUX DEV
00110 MOVE W,SYMEXT ;SEE IF EXTENSION SPECIFIED
00120 HRLZM W,DTIN1
00130 TLZ F,ISW
00140 TLO F,ESW
00150 MOVSI W,'DSK'
00160 MOVEM W,ILD1
00170 PUSHJ P,ILD
00180 PUSH P,S ;SAVE NUMBER OF UNDEFINED SYMBOLS FOR LATER
00190 HLRE V,S ;GET COUNT
00200 MOVMS V ;AND CONVERT TO POSITIVE
00210 HRLI B,V ;PUT V IN INDEX FIELD
00220 HRRZ S,HISTRT ;TOP OF CORE
00230 SUB S,V ;MINUS SIZE
00240 HRLI S,V ;V IN INDEX FIELD
00250 ;MOW MOVE FROM S TO B
00260 MOVE W,@B
00270 MOVEM W,@S
00280 SOJG V,.-2 ;FOR ALL ITEMS
00290 HRRM S,(P) ;S IS NOW BOTTOM OF UNDEFINED
00300 POP P,S ;SO PUT COUNT BACK INTO S
00310 HRRZ B,HISTRT ;POINT B TO TOP OF CORE FOR EXPAND
00320 MOVE V,SYMCNT# ;GET NUMBER OF SYMBOLS
00330 LSH V,1 ;2 WORDS PER SYMBOL
00340 SUBI V,(S) ;BOTTOM OF SYMBOL TABLE
00350 ADDI V,(H) ;-TOP OF CODE
00360 JUMPL V,.+3
00370 PUSHJ P,XPAND9
00380 JRST MORCOR
00390 MOVE V,SYMCNT ;GET COUNT AGAIN
00400 LSH V,1
00410 MOVNS V ;NEGATE
00420 HRRZ C,S
00430 ADD C,V ;TO
00440 HRL C,S ;FROM
00450 HLRE W,S ;LENGTH
00460 MOVMS W ;POSITIVE
00470 ADDI W,(C) ;END OF BLT
00480 BLT C,(W) ;MOVE UNDEFS AGAIN
00490 ADD S,V ;FIXUP POINTER
00500 SETZM NAMPTR ;HAVE NOT SEEN A PROG YET
00510 MOVE T,SYMCNT ;NUMBER OF SYMBOL PAIRS TO READ
00520 READS1: PUSHJ P,WORDPR
00530 MOVEM W,(B)
00540 MOVEM C,-1(B)
00550 SUB B,SE3
00560 TLNN C,740000 ;NAME HAS NO CODE BITS SET
00570 JRST READS2 ;YES, HANDLE IT
00580 SOJG T,READS1 ;READ NEXT SYMBOL
00590 JRST READS4 ;ALL DONE
00600
00610 READS2: MOVE W,NAMPTR ;POINT TO PREVIOUS NAME
00620 HRRZM B,NAMPTR ;POINT TO THIS ONE
00630 JUMPE W,READS3 ;FIRST TIME?
00640 MOVE C,W ;GET COPY
00650 SUBM B,W ;COMPUTE RELATIVE POSITION
00660 HRLM W,2(C) ;STORE BACK
00670 READS3: SOJG T,READS1
00680
00690 READS4: MOVEI T,'SYM'
00700 CAMN T,SYMEXT ;IF EXT IS SYM
00710 JRST READS5 ;DON'T DELETE FILE
00720 SETZM DTIN
00730 SETZM DTIN+3
00740 RENAME 1,DTIN
00750 JFCL
00760 READS5: SETOM SYMEXT ;SIGNAL NOT TO INIT SYMBOL FILE AGAIN
00770 POPJ P,
00780 >
00010 SUBTTL WRITE CHAIN FILES
00020 IFE K,< ;DONT INCLUDE IN 1KLOAD
00030 CHNC: SKIPA A,.JBCHN(X) ;CHAIN FROM BREAK OF FIRST BLOCK DATA
00040 CHNR: HLR A,.JBCHN(X) ;CHAIN FROM BREAK OF FIRST F4 PROG
00050 HRRZS A ;ONLY RIGHT HALF IS SIGNIFICANT
00060 JUMPE A,LD7C ;DON'T CHAIN IF ZERO
00070 TLZN N,AUXSWI!AUXSWE ;IS THERE AN AUX DEV?
00080 JRST LD7D ;NO, DON'T CHAIN
00090 PUSH P,A ;SAVE WHEREFROM TO CHAIN
00100 JUMPE D,.+2 ;STARTING ADDR SPECIFIED?
00110 HRRZM D,STADDR ;USE IT
00120 CLOSE 2, ;INSURE END OF MAP FILE
00130 PUSHJ P,SASYM ;DO LIB SEARCH, SETUP JOBSA, ETC.
00140 IFN RPGSW,<TLNE N,RPGF ;IF IN CCL MODE
00150 TDZA W,W ;NO MESSAGES>
00160 MOVE W,[SIXBIT ?CHAIN?] ;FINAL MESSAGE
00170 PUSHJ P,BLTSET ;SETUP BLT PNTR, SETDDT, RELEAS
00180 POP P,A ;GET WHEREFROM
00190 HRRZ W,R ;CALCULATE MIN IOWD NECESSARY
00200 SKIPE .JBDDT(X) ;IF JOBDDT KEEP SYMBOLS
00210 CAILE W,1(S)
00220 JRST CHNLW1
00230 HRRZ W,.JBREL ;NEED SYMBOLS AND THEY HAVE NOT MOVED DOWN
00240 SUBI W,(X) ;BECAUSE WE WILL NOT HAVE BLITTED
00250 SUBI B,-1(X) ;SYMBOL TABLE WILL COME OUT IN A
00260 MOVEM B,.JBSYM(X) ;DIFFERENT PLACE
00270 CHNLW1: MOVNS W
00280 ADDI W,-7(A)
00290 ADDI A,-7(X)
00300 PUSH A,W ;SAVE LENGTH
00310 HRLI W,-1(A)
00320 MOVSM W,IOWDPP ;...
00330 SETZM IOWDPP+1 ;JUST IN CASE
00340 PUSH A,.JBCHN(X)
00350 PUSH A,.JBSA(X) ;SETUP SIX WORD TABLE
00360 PUSH A,.JBSYM(X) ;...
00370 PUSH A,.JB41(X)
00380 PUSH A,.JBDDT(X)
00390 SETSTS 2,17 ;SET AUX DEV TO DUMP MODE
00400 MOVSI W,'CHN' ;USE .CHN AS EXTENSION
00410 MOVEM W,DTOUT1 ;...
00420 PUSHJ P,IAD2 ;DO THE ENTER
00430 JRST LD2 ;ENTER FAILURE
00440 OUTPUT 2,IOWDPP ;WRITE THE CHAIN FILE
00450 STATZ 2,IOBAD!IODEND
00460 JRST LOSEBIG
00470 CLOSE 2,
00480 STATZ 2,IOBAD!IODEND
00490 IFN RPGSW,<JRST LOSEBIG
00500 TLNE N,RPGF ;IF IN CCL MODE
00510 JRST CCLCHN ;LOAD NEXT LINK
00520 EXIT>
00530 LOSEBI: TTCALL 3,[ASCIZ /?DEVICE ERROR/]
00540 EXIT>
00010 SUBTTL SPECIAL CHAINB
00020 IFN SPCHN,<
00030 CHNBG: PUSHJ P,FSCN1A ;FORCE SCAN TO COMPLETION FOR CURRENT FILE
00040 TLNN N,AUXSWI ;IS THERE AN AUX DEV??
00050 JRST CHNBG1 ;NO, SKIP THIS CODE
00060 PUSH P,W ;PRESERVE W
00070 MOVE W,CHNOUT+1 ;GET AUX DEV
00080 DEVCHR W, ;GET ITS CHARACTERISTICS
00090 TLNN W,DSKBIT ;IS IT A REAL DSK?
00100 TLZA N,AUXSWI!AUXSWE ;NO, RELEASE MAP DEVICE
00110 TLNN N,AUXSWE!AUXSWI ;SHOULD AUX DEVICE BE RELEASED?
00120 RELEAS 2, ;YES, RELEAS IT SO ENTER WILL NOT FAIL
00130 POP P,W ;RESTORE W
00140 CHNBG1: ;LABEL TO SKIP AUX DEV. CHECKING
00150 IFN REENT,<TRO N,VFLG ;GIVE HIM REENTRANT FORSE UNLESS /-V SEEN>
00160 HRLZI W,-1(R) ;CHNTAB-L = ADDRESS OF VECTOR TABLE
00170 HRRI W,1 ;CHNTAB-R = NEXT DISK BLOCK TO RITE INTO
00180 MOVEM W,CHNTAB
00190 MOVE C,[RADIX50 4,OVTAB] ;DEFINE GLOBAL SYMBOL OVTAB
00200 MOVEI W,(R) ;TO HAVE VALUE THE BEGINNING OF THE VECTOR TABLE
00210 PUSHJ P,SYMPT
00220 ADDI R,VECLEN ;RESERVE SPACE FOR VECTOR TABLE
00230 MOVE C,[RADIX50 4,OVBEG] ;OVBEG IS BEGINNING OF OVERLAY AREA
00240 MOVEI W,(R)
00250 PUSHJ P,SYMPT
00260 HRRZM R,BEGOV ;AND SAVE IN OVBEG
00270 SETZM LINKNR ;SET CURRENT LINK # TO ZERO
00280 TRZ N,CHNMAP ;SHOW ROOT NOT PRINTED
00290 OPEN 4,CHNOUT ;OPEN FILE FOR CHAIN
00300 JRST ILD5 ;CANT OPEN CHAIN FILE
00310 SKIPE CHNENT ;TEST FOR DEFINED CHAIN-FILE NAME
00320 JRST CHNBG2 ;YES, SKIP
00330 PUSH P,W ;SAVE W
00340 IFN NAMESW,<
00350 SKIPN W,CURNAM ;GET CURRENT NAME & TEST FOR DEFINED >
00360 MOVE W,['CHAIN '] ;SET NAME = 'CHAIN'
00370 MOVEM W,CHNENT ;AND STORE AS FILE NAME
00380 POP P,W ;RESTORE W
00390 CHNBG2: ENTER 4,CHNENT ;ENTER CHAIN FILE
00400 JRST CHNBG3 ;ERROR
00410 HRRZ W,NAMPTR
00420 SUB W,HISTRT ;KEEP N RIGHT HALF AS RELATIVE TO HISTRT
00430 HRRZM W,CHNACN ;SAVE FOR RESTORING
00440 MOVEM B,CHNACB ;ALSO B R IS SAVED IN BEGOV
00450 TRNE N,ENDMAP ;TEST FOR DEFERED MAP REQUEST
00460 PUSHJ P,PRTMAP ;YES, PRINT IT NOW
00470 AOS LINKNR ;SET LINE NUMBER TO 1
00480 POPJ P,
00490
00500 CHNBG3: ERROR ,</ERROR WRITING CHAIN@/>
00510 POPJ P,
00010
00020 CHNENS: TLOA N,PPCSW ;THIS FLAG UNUSED AT THIS POINT
00030 CHNEN: TLZ N,PPCSW ;ON TO NOT DELETE NEW SYMBOLS
00040 SKIPN CHNACB ;WILL BE NON-ZERO IF WE SAW A /< (> TO KEEP MACRO HAPPY)
00050 JRST LD7D ;ERROR MESSAGE
00060 PUSHJ P,FSCN1A ;LOAD LIB (IF DESIRED) AND FORCE SCAN
00070 TRNE N,ENDMAP ;TEST FOR DEFERED MAP REQUEST
00080 PUSHJ P,PRTMAP ;YES, PRINT IT
00090 AOS LINKNR ;INCR TO NEXT LINK NUMBER
00100 SKIPL Q,S ;CHECK SYMBOL TABLE FOR MISSED UNDEFS
00110 JRST NOER ;NONE THERE
00120 MOVEI E,0 ;COUNT OF ERRORS
00130 ONCK:
00140 IFN FAILSW,<SKIPL V,1(Q) ;IF HIGH ORDER BIT IS ON
00150 TLNN V,740000 ;OR IF ALL CODE BITS 0
00160 JRST NXTCK ;THEN NOT TO BE CHECKED>
00170 MOVE V,2(Q) ;GET FIXUP WORD
00180 TLNE V,100000 ;BIT INDICATES SYMBOL TABLE FIXUP
00190 JRST SMTBFX
00200 IFN FAILSW,<TLNE V,40000 ;BIT INDICATES POLISH FIXUP
00210 JRST POLCK>
00220 TLZE V,740000 ;THESE BITS WOULD MEAN ADDITIVE
00230 JRST [JSP A,CORCKL
00240 JRST NXTCK] ;ONLY TRY FIRST LOCATION
00250 CORCK: JSP A,CORCKL
00260 HRRZ V,@X ;THE WAY TO LINK
00270 CORCKL: IFN REENT,<CAMGE V,HVAL1>
00280 CAMGE V,BEGOV
00290 SKIPA ;NOT IN BAD RANGE
00300 JRST ERCK ;BAD, GIVE ERROR
00310 JUMPE V,NXTCK ;CHAIN HAS RUN OUT
00320 IFN REENT,<CAMGE V,HVAL1 ;GET CORRECT LINK
00330 SKIPA X,LOWX
00340 MOVE X,HIGHX>
00350 XCT (A) ;TELLS US WHAT TO DO
00360 JRST CORCKL ;GO ON WITH NEXT LINK
00010 SMTBFX: TLNE N,PPCSW ;IF NOT CUTTING BACK SYMBOL TABLE
00020 JRST NXTCK ;THE ALL OK
00030 ADD V,HISTRT ;GET PLACE TO POINT TO
00040 HRRZS V
00050 HLRE D,CHNACB ;OLD LENGTH OF TABLE (NEGATIVE)
00060 HLRE T,B ;NEW LENGTH
00070 SUB D,T ;-OLD LEN+NEW LEN
00080 ADDI D,(B) ;OLD BOTTOM=NEW BOTTOM+NEW LEN-OLD LEN
00090 CAIG V,(D) ;IS IT IN THE PART WE ARE KEEPING
00100 JRST ERCK
00110 JRST NXTCK ;YES
00120 IFN FAILSW,<POLCK: HLRZ C,V ;FIND HEADER
00130 PUSHJ P,SREQ
00140 SKIPA
00150 JRST LOAD4A ;SHOULD BE THERE
00160 HRL C,2(A) ;NOW FIRST OPERATOR (STORE)
00170 MOVSS C
00180 PUSHJ P,SREQ
00190 SKIPA
00200 JRST LOAD4A
00210 ANDI C,37 ;GET OPERATION
00220 HRRZ V,2(A) ;DESTINATION
00230 JRST @CKSMTB-15(C) ;DISPATCH
00240 CKSMTB: EXP SMTBFX,SMTBFX,SMTBFX,CORCK,LCORCK,CORCK,NXTCK
00250 LCORCK: JSP A,CORCKL
00260 HLRZ V,@X>
00270 ERCK: MOVE C,1(Q) ;GET SYMBOL NAME
00280 PUSHJ P,FCRLF ;FORCE CRLF AND OUTPUT ON TTY
00290 PUSHJ P,PRNAME ;PRINT IT
00300 ADDI E,1 ;MARK ERROR
00310 NXTCK: ADD Q,SE3 ;TRY ANOTHER
00320 JUMPL Q,ONCK
00330 IFN REENT,<PUSHJ P,RESTRX ;GET PROPER X BACK>
00340 JUMPE E,NOER ;DID ANYTHING GO WRONG??
00350 ERROR ,</UNDEFINED GLOBAL(S) IN LINK@/>
00360 TRZE N,ENDMAP ;DELAYED MAP IN PIPELINE
00370 PUSHJ P,PRTMAP ;YES, GO DO IT
00380 JRST LD2 ;GIVE UP
00390
00400 NOER: TRZE N,ENDMAP ;DELAYED MAP IN PIPELINE
00410 PUSHJ P,PRTMAP ;YES, GO DO IT
00420 MOVE A,BEGOV ;GET START OF OVERLAY
00430 ADDI A,(X) ;GET ACTUAL CURRENT LOCATION
00440 IFN REENT,<HRRZ W,HILOW ;AND END OF OVERLAY+1
00450 HRRZM A,HILOW ;RESET>
00460 IFE REENT,<HRRZ W,R
00470 ADDI W,(X) ;A BETTER GUESS>
00480 SUBM A,W ;W=-LENGTH
00490 SUBI A,1 ;SET TO BASE-1 (FOR IOWD)
00500 HRL A,W ;GET COUNT
00510 MOVEM A,IOWDPP
00520 SETZM IOWDPP+1
00530 HRR A,CHNTAB ;BLOCK WE ARE WRITING ON
00540 HLRZ V,CHNTAB ;POINTER TO SEGMENT TABLE
00550 ADDI V,1 ;NEXT LOCATION
00560 HRLM V,CHNTAB ;REMEMBER IT
00570 CAML V,BEGOV ;CHECK FOR OVERRUN
00580 JRST [ERROR ,</?TOO MANY LINKS@/>
00590 JRST LD2];GIVE UP
00600 MOVEM A,@X ;PUT INTO TABLE
00610 MOVN W,W ;GET POSITIVE LENGTH
00620 MOVE C,CHNOUT+1 ;GET CHAIN DEV.
00630 DEVCHR C, ;WHAT IS IT?
00640 MOVEI A,DSKBLK ;ASSUME DSK
00650 TRNE C,DTABIT ;BUT IF DTA
00660 MOVEI A,DTABLK ;BLOCK IS 177
00670 ADDI W,-1(A)
00680 IDIV W,A ;GET NUMBER OF BLOCKS
00690 ADDM W,CHNTAB ;AND UPDATE
00700 TLZE N,PPCSW
00710 JRST NOMVB ;DO NOT ADJUST SYMBOLS
00720 HLRE W,CHNACB ;GET OLD LENGTH OF DEF SYMBOLS
00730 HLRE C,B ;AND NEW LENGTH
00740 SUB W,C ;-OLD LEN+NEW LEN
00010 HRRZ C,B ;SAVE POINTER TO CURRENT S
00020 ADD S,W
00030 HRL W,W
00040 ADD B,W ;UPDATE B (COUNT AND LOC)
00050 JUMPGE S,UNLNKD ;JUST IN CASE NOTHING TO MOVE
00060 HRRZ A,B ;PLACE TO PUT UNDEFS
00070 UNLNK: MOVE W,(C)
00080 MOVEM W,(A) ;TRANSFER
00090 SUBI A,1
00100 CAIE A,(S) ;HAVE WE MOVED LAST WORD??
00110 SOJA C,UNLNK ;NO, CONTINUE
00120 UNLNKD: HRRZ W,CHNACN ;GET SAVED N
00130 ADD W,HISTRT
00140 HRRZM W,NAMPTR ;AND RESET IT
00150 NOMVB: HRR R,BEGOV ;PICK UP BASE OF AREA
00160 SETSTS 4,16 ;SET DUMP MODE IN CASE OF INTERACTION WITH OTHER CHANNELS
00170 OUTPUT 4,IOWDPP ;DUMP IT
00180 STATZ 4,IOBAD!IODEND ;AND ERROR CHECK
00190 JRST LOSEBI
00200 HRRZ V,R ;GET AREA TO ZERO
00210 MOVEI W,@X
00220 CAIL W,1(S) ;MUST MAKE SURE SOME THERE
00230 POPJ P, ;DONE
00240 SETZM (W)
00250 CAIL W,(S)
00260 POPJ P,
00270 HRLS W
00280 ADDI W,1
00290 BLT W,(S) ;ZERO WORLD
00300 POPJ P,
00310 >
00010 SUBTTL EXPAND CORE
00020
00030 IFN EXPAND,<
00040 XPAND: TLNE F,FULLSW ;IF CORE EXCEEDED
00050 POPJ P, ;DON'T WASTE TIME ON CORE UUO
00060 PUSH P,Q
00070 HRRZ Q,.JBREL
00080 ADDI Q,2000
00090 XPAND1: PUSH P,H ;GET SOME REGISTERS TO USE
00100 PUSH P,X
00110 PUSH P,N
00120 PUSH P,.JBREL ;SAVE PREVIOUS SIZE
00130 CAMG Q,ALWCOR ;CHECK TO SEE IF RUNNING OVER
00140 CORE Q,
00150 JRST XPANDE
00160 IFE K,< HRRZ H,MLTP ;GET LOWEST LOCATION
00170 TLNN N,F4SW ;IS FORTRAN LOADING>
00180 MOVEI H,1(S) ;NO, USE S
00190 POP P,X ;LAST .JBREL
00200 HRRZ Q,.JBREL;NEW JOBREL
00210 SUBI Q,(X) ;GET DIFFERENCE
00220 HRLI Q,X ;PUT X IN INDEX FIELD
00230 XPAND2: MOVE N,(X)
00240 MOVEM N,@Q
00250 CAMLE X,H ;TEST FOR END
00260 SOJA X,XPAND2
00270 HRLI H,-1(Q)
00280 TLC H,-1 ;MAKE IT NEGATIVE
00290 SETZM (H) ;ZERO NEW CORE
00300 AOBJN H,.-1
00310 MOVEI H,(Q)
00320 XPAND8: ADD S,H
00330 ADD B,H
00340 ADDM H,HISTRT ;UPDATE START OF HISEG
00350 IFN REENT,<ADDM H,HIGHX ;AND STORE LOCATION
00360 TLNE F,HIPROG
00370 ADDM H,-1(P) ;X IS CURRENTLY IN THE STACK>
00380 POP P,N
00390 ADDM H,NAMPTR
00400 IFE K,<
00410 IFN MANTIS,<SKIPE MNTSYM ;DEBUGGER DATA PRESENT?
00420 ADDM H,MNTSYM>
00430 TLNN N,F4SW ;F4?
00440 JRST XPAND3
00450 ADDM H,PLTP
00460 ADDM H,BITP
00470 ADDM H,SDSTP
00480 ADDM H,MLTP
00490 TLNE N,SYDAT
00500 ADDM H,V>
00510 XPAND3: AOSA -3(P)
00520 XPAND5: POP P,N
00530 POP P,X
00540 POP P,H
00550 POP P,Q
00560 POPJ P,
00010
00020 XPANDE: POP P,A ;CLEAR JOBREL OUT OF STACK
00030 XPAND6: ERROR ,</MORE CORE NEEDED#/>
00040 TLO F,FULLSW ;ONLY ONCE
00050 JRST XPAND5
00060
00070 XPAND7: PUSHJ P,XPAND
00080 JRST SFULLC
00090 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00100 JRST POPJM3 ;YES, RETURN TO CALL-2>
00110 JRST POPJM2
00120
00130 XPAND9: PUSH P,Q ;SAVE Q
00140 HRRZ Q,.JBREL ;GET CORE SIZE
00150 ADDI Q,(V) ;ADD XTRA NEEDED
00160 JRST XPAND1 ;AND JOIN COMMON CODE
00170
00180 POPJM3: SOS (P) ;POPJ TO CALL-2
00190 POPJM2: SOS (P) ;POPJ TO CALL-1
00200 SOS (P) ;SAME AS POPJ TO
00210 POPJ P, ;NORMAL POPJ MINUS TWO
00220 >
00230
00010 SUBTTL SWITCH HANDLING
00020
00030 ;ENTER SWITCH MODE
00040
00050 LD6A: CAIN T,57 ;WAS CHAR A SLASH?
00060 TLO N,SLASH ;REMEBER THAT
00070 LD6A2: TLO F,SSW ;ENTER SWITCH MODE
00080 LD6A1: SETZB D,C ;ZERO TWO REGS FOR DECIMAL AND OCTAL
00090 IFN SYMARG,<TRZ F,ARGFL ;CLEAR SPECIAL SYMBOL SWITCH >
00100 JRST LD3 ;EAT A SWITCH
00110
00120 ;ALPHABETIC CHARACTER, SWITCH MODE
00130
00140 LD6:
00150 CAIL T,141 ;ACCEPT LOWER CASE SWITCHES
00160 SUBI T,40
00170 IFN SPCHN,<XCT LD6B-74(T) ;EXECUTE SWITCH FUNCTION>
00180 IFE SPCHN,<XCT LD6B-101(T) ;EXECUTE SWITCH FUNCTION>
00190 TLZE N,SLASH ;SWITCH MODE ENTERED W/ SLASH?
00200 JRST LD6D ;LEAVE SWITCH MODE
00210 JRST LD6A1 ;STAY IN SWITCH MODE
00220
00010 ;DISPATCH TABLE FOR SWITCHES
00020
00030 ; THE INSTRUCTION AT THE CHARACTER LOCATION IS EXECUTED
00040
00050 LD6B:
00060 IFN SPCHN,<PUSHJ P,CHNBG ;LESS THAN - BEGINNING OF OVERLAY
00070 PUSHJ P,CHNENS ;= - PUT OUT CHAIN RETAINING SYMBOLS
00080 PUSHJ P,CHNEN ;GREATER THAN - END OF OVERLAY
00090 JRST LD7B ;? - ERROR
00100 JRST LD7B ;@ - ERROR>
00110 PUSHJ P,ASWTCH ;A - LIST ALL GLOBALS
00120 IFN DMNSW,<PUSHJ P,DMN2 ;B - BLOCKS DOWN SYMBOL TABLE >
00130 IFE DMNSW,<JRST LD7B ;B - ERROR>
00140 IFE K,< PUSHJ P,CHNC ;C - CHAIN, START W/ COMMON>
00150 IFN K,< JRST LD7B ;C - ILLEGAL IN 1KLOAD>
00160 PUSHJ P,LDDT ;D - DEBUG OPTION, LOAD DDT
00170 TLO N,EXEQSW ;E - LOAD AND GO
00180 PUSHJ P,LIBF0 ;F - LIBRARY SEARCH
00190 PUSHJ P,LD5E ;G - GO INTO EXECUTION
00200 IFN REENT,<PUSHJ P,HSET ;H - REENTRANT. PROGRAM>
00210 IFE REENT,<JFCL ;JUST IGNORE /H>
00220 PUSHJ P,ISWTCH ;I - IGNORE STARTING ADDRESSES
00230 TLZ N,ISAFLG ;J - USE STARTING ADDRESSES
00240 IFE KUTSW,<JRST LD7B ;K - ERROR>
00250 IFN KUTSW,<MOVEM C,CORSZ ;K - SET DESIRED CORE SIZE>
00260 PUSHJ P,LSWTCH ;L - ENTER LIBRARY SEARCH
00270 PUSHJ P,PRMAP ;M - PRINT STORAGE MAP
00280 TLZ F,LIBSW+SKIPSW ;N - LEAVE LIBRARY SEARCH
00290 HRR R,D ;O - NEW PROGRAM ORIGIN
00300 PUSHJ P,PSWTCH ;P - PREVENT AUTO. LIB. SEARCH
00310 TLZ F,NSW ;Q - ALLOW AUTO. LIB. SEARCH
00320 IFE K,< PUSHJ P,CHNR ;R - CHAIN, START W/ RESIDENT>
00330 IFN K,< JRST LD7B ;R - ILLEGAL IN 1KLOAD>
00340 PUSHJ P,SSWTCH ;S - LOAD WITH SYMBOLS
00350 PUSHJ P,LDDTX ;T - LOAD AND GO TO DDT
00360 PUSHJ P,PMSQ ;U - PRINT UNDEFINED LIST
00370 IFN REENT,<PUSHJ P,VSWTCH ;V - LOAD REENTRANT LIB40>
00380 IFE REENT,<JRST LD7B ;V - ERROR>
00390 TLZ F,SYMSW+RMSMSW ;W - LOAD WITHOUT SYMBOLS
00400 TLZ N,ALLFLG ;X - DO NOT LIST ALL GLOBALS
00410 IFE TENEX,<TLO F,REWSW ;Y - REWIND BEFORE USE>
00420 IFN TENEX,<PUSHJ P,NEWPAG ;Y - ORIGIN TO NEXT PAGE BOUNDARY>
00430 IFE L,< JRST LDRSTR ;Z - RESTART LOADER>
00440 IFN L,< JRST LD7B ;Z -- ILLEGAL IN LISP LOADER>
00450
00010 ; PAIRED SWITCHES ( +,-)
00020
00030 ASWTCH: JUMPL D,.+2 ;SKIP IF /-A
00040 TLOA N,ALLFLG ;LIST ALL GLOBALS
00050 TLZ N,ALLFLG ;DON'T
00060 POPJ P,
00070
00080 ISWTCH: JUMPL D,.+2 ;SKIP IF /-I
00090 TLOA N,ISAFLG ;IGNORE STARTING ADDRESSES
00100 TLZ N,ISAFLG ;DON'T
00110 POPJ P,
00120
00130 LSWTCH: JUMPL D,.+2 ;SKIP IF /-L
00140 TLOA F,LIBSW!SKIPSW ;ENTER LIBRARY SEARCH
00150 TLZ F,LIBSW!SKIPSW ;DON'T
00160 POPJ P,
00170
00180 PSWTCH: JUMPL D,.+2 ;SKIP IF /-P
00190 TLOA F,NSW ;PREVENT AUTO. LIB SEARCH
00200 TLZ F,NSW ;ALLOW
00210 POPJ P,
00220
00230 SSWTCH: JUMPL D,.+2 ;SKIP IF /-S
00240 TLOA F,SYMSW!RMSMSW ;LOAD WITH SYMBOLS
00250 IFE MANTIS,<TLZ F,SYMSW!RMSMSW ;DON'T>
00260 IFN MANTIS,<TLZA F,SYMSW!RMSMSW ;DON'T
00270 TRZ N,SYMFOR ;SYMBOLS LOAD EXPLICITLY SPECIFIED>
00280 POPJ P,
00290
00300 IFN REENT,<
00310 VSWTCH: JUMPL D,.+2 ;SKIP IF /-V
00320 MOVEI D,1 ;SET VSW = +1 FOR /V
00330 MOVEM D,VSW ; = -1 FOR /-V
00340 POPJ P,>
00350
00360 IFN TENEX,<
00370 ;Y SWITCH - START LOADING AT NEXT PAGE BOUNDARY
00380 NEWPAG: JUMPL C,NEWLPG ;/-Y BUMPS LOWSEG LOC
00390 ADDI R,777 ;/Y BUMPS HISEG LOC
00400 ANDCMI R,777
00410 POPJ P,0
00420
00430 NEWLPG: MOVE D,LOWR
00440 ADDI D,777
00450 ANDCMI D,777
00460 MOVEM D,LOWR
00470 POPJ P,0
00480
00490 >
00010 IFN REENT,<
00020 ; H SWITCH --- EITHER /H OR /NH
00030 HSET: JUMPE D,SETNUM ;/H ALWAYS LEGAL
00040 CAIGE D,2 ;WANT TO CHANGE SEGMENTS
00050 JRST SETSEG ;YES,GO DO IT
00060 TRNN F,SEENHI ;STARTED TO LOAD YET?
00070 JRST HCONT ;NO, CONTINUE.
00080 IFE TENEX,<ERROR ,<?/H ILLEGAL AFTER FIRST HISEG FILE IS LOADED@?>>
00090 IFN TENEX,<HRRZ C,HVAL
00100 CAIGE D,0(C)
00110 JRST HSET69
00120 HRRM D,HIGHR ;MOVE UP HIGH BREAK
00130 POPJ P,0
00140
00150 HSET69: ERROR ,<?/H ILLEGAL: ATTEMPT TO LOWER HISEG BREAK@?>
00160 POPJ P,0>
00170 >
00180
00190 IFE L,<
00200 LDRSTR: ERROR 0,</LOADER RESTARTED@/>
00210 JRST BEG ;START AGAIN (NO CCL)>
00220 IFN REENT,<
00230 HCONT: HRRZ C,D
00240 IFE TENEX,<ANDCMI C,1777
00250 CAIL C,400000>
00260 CAIG C,(H)
00270 JRST COROVL ;BEING SET LOWER THAN 400000 OR MORE THAN TOP OF LOW SEG
00280 HRRZM C,HVAL1 ;WE HAVE REMOVED THE ODD BITS TO MAKE A 1K MULT
00290 ADDI C,.JBHDA
00300 CAILE C,(D) ;MAKE SURE OF ENOUGH ROOM
00310 MOVE D,C
00320 HRLI D,W ;SET UP W IN LEFT HALF
00330 MOVEM D,HVAL
00340 POPJ P, ;RETURN.
00350
00360 COROVL: ERROR ,</HISEG STARTING ADDRESS TOO LOW@/>
00370 JRST LDRSTR
00380 SETNUM: TRO F,NOHI ;SET NO-HIGH-SEG SWITCH.
00390 POPJ P,>
00010 ;SWITCH MODE NUMERIC ARGUMENT
00020
00030 LD6C: LSH D,3 ;BUILD OCTAL NUMERIC ARGUMENT
00040 ADDI D,-60(T)
00050 IMULI C,↑D10
00060 ADDI C,-"0"(T) ;ACCUMULATE DEC AND OCTAL
00070 JRST LD3
00080
00090 ;EXIT FROM SWITCH MODE
00100
00110 LD6D: TLZ F,SSW ;CLEAR SWITCH MODE FLAG
00120 TLNE F,FSW ;TEST FORCED SCAN FLAG
00130 JRST LD2D ;SCAN FORCED, START NEW IDENT.
00140 JRST LD3 ;SCAN NOT FORCED, USE PREV IDENT
00150 ;ILLEGAL CHARACTER, NORMAL MODE
00160
00170 LD7: IFN SYMARG,<
00180 CAIN T,"#" ;DEFINING THIS SYMBOL
00190 JRST DEFINE ;YES
00200 TRNN F,ARGFL ;TREAT AS SPECIAL
00210 JRST .+4 ;NO
00220 CAIE T,"$"
00230 CAIN T,"%"
00240 JRST LD4 ;YES>
00250 CAIN T,"Z"-100 ;TEST FOR ↑Z
00260 JRST LD5E1 ;TREAT AS ALTMODE FOR BATCH
00270 ERROR 8,</CHAR.%/>
00280 JRST LD2 ;TRY TO CONTINUE
00290
00300 ;SYNTAX ERROR, NORMAL MODE
00310
00320 LD7A: ERROR 8,</SYNTAX%/>
00330 JRST LD2
00340
00350 ;ILLEGAL CHARACTER, SWITCH MODE
00360
00370 LD7B: CAIN T,"-" ;SPECIAL CHECK FOR -
00380 JRST [SETOB C,D
00390 JRST LD3]
00400 CAIN T,"Z"-100 ;CHECK FOR /↑Z
00410 JRST LD5E1 ;SAME AS ↑Z
00420 ERROR 8,</SWITCH%/>
00430 JRST LD2
00010 ;ATTEMPT TO CHAIN WITH SPECIFIED HALF OF JOBCHN = 0
00020
00030 IFE K,<
00040 LD7C: ERROR ,<?UNCHAINABLE AS LOADED@?>
00050 JRST LD2
00060
00070 ;ATTEMP TO CHAIN WITHOUT SPECIFYING DEVICE
00080
00090 LD7D: ERROR ,<?NO CHAIN DEVICE@?>
00100 JRST LD2>
00110
00120 IFN DMNSW,<
00130 DMN2:
00140 IFN REENT,<CAIN D,1 ;SPECIAL CASE
00150 TROA F,HISYM ;YES ,BLT SYMBOLS INTO HISEG>
00160 JUMPL D,.+2
00170 TROA F,DMNFLG ;TURN ON /B
00180 TRZ F,DMNFLG ;TURN OFF IF /-B
00190 CAMLE D,KORSP
00200 MOVEM D,KORSP
00210 POPJ P, ;RETURN>
00220
00010 SUBTTL CHARACTER CLASSIFICATION TABLE DESCRIPTION:
00020
00030 ; EACH CHARACTER HAS ASSOCIATED WITH IT A FOUR BIT BYTE
00040 ; PACKED IN THE CHARACTER CLASSIFICATION TABLE. THE CHARACTER
00050 ; CLASSIFICATION CODES ARE ORDERED IN SUCH A WAY AS TO GIVE
00060 ; DELIMITERS OF HIGHER PRECEDENCE LOWER CLASSIFICATION NUMBERS.
00070 ; CERTAIN CHARACTERS HAVE NO EFFECT ON THE COMMAND STRING, AND
00080 ; THEREFORE DO NOT EFFECT ORDERING OF DELIMITERS. FOUR CODES
00090 ; ARE RESERVED FOR ALTERNATE DISPATCHES WHILE THE SWITCH MODE IS
00100 ; IN EFFECT.
00110
00120
00130 ;CLASSIFICATION BYTE CODES:
00140
00150 ; BYTE DISP CLASSIFICATION
00160
00170 ; 00 - 00 ILLEGAL CHARACTER, SWITCH MODE
00180 ; 01 - 01 ALPHABETIC CHARACTER, SWITCH MODE
00190 ; 02 - 02 NUMERIC CHARACTER, SWITCH MODE
00200 ; 03 - 03 SWITCH MODE ESCAPE, SWITCH MODE
00210
00220 ; 00 - 04 ILLEGAL CHARACTER, NORMAL MODE
00230 ; 01 - 05 ALPHABETIC CHARACTER, NORMAL MODE
00240 ; 02 - 06 NUMERIC CHARACTER, NORMAL MODE
00250 ; 03 - 07 SWITCH MODE ESCAPE, NORMAL MODE
00260
00270 ; 04 - 10 IGNORED CHARACTER
00280 ; 05 - 11 ENTER SWITCH MODE CHARACTER
00290 ; 06 - 12 DEVICE IDENTIFIER DELIMITER
00300 ; 07 - 13 FILE EXTENSION DELIMITER
00310 ; 10 - 14 OUTPUT SPECIFICATION DELIMITER
00320 ; 11 - 15 INPUT SPECIFICATION DELIMITER
00330 ; 12 - 16 LINE TERMINATION
00340 ; 13 - 17 JOB TERMINATION
00010 ;BYTE POINTERS TO CHARACTER CLASSIFICATION TABLE
00020
00030 LD8: POINT 4,LD9(Q),3
00040 POINT 4,LD9(Q),7
00050 POINT 4,LD9(Q),11
00060 POINT 4,LD9(Q),15
00070 POINT 4,LD9(Q),19
00080 POINT 4,LD9(Q),23
00090 POINT 4,LD9(Q),27
00100 POINT 4,LD9(Q),31
00110 POINT 4,LD9(Q),35
00120
00130 ;CHARACTER CLASSIFICATION TABLE
00140
00150 LD9: BYTE (4)4,0,0,0,0,0,0,0,0
00160 BYTE (4)4,4,4,4,12,0,0,0,0
00170 BYTE (4)0,0,0,0,0,0,0,0,0
00180 BYTE (4)13,0,0,0,0,4,0,4,0
00190 IFE SYMARG,< BYTE (4)0,0,0,0,5,3,0,0,11>
00200 IFN SYMARG,< BYTE (4)0,0,14,0,5,3,0,0,11>
00210 BYTE (4)0,7,5,2,2,2,2,2,2
00220 IFE SPCHN,< BYTE (4)2,2,2,2,6,0,0,10,0>
00230 IFN SPCHN,< BYTE (4)2,2,2,2,6,0,1,10,1>
00240 IFE RPGSW,< BYTE (4)0,0,1,1,1,1,1,1,1>
00250 IFN RPGSW,< BYTE (4) 0,10,1,1,1,1,1,1,1>
00260 BYTE (4)1,1,1,1,1,1,1,1,1
00270 BYTE (4)1,1,1,1,1,1,1,1,1
00280 IFE PP,<BYTE (4)1,0,0,0,0,10,0,1,1>
00290 IFN PP,<BYTE (4)1,10,0,10,0,10,0,1,1>
00300 BYTE (4)1,1,1,1,1,1,1,1,1
00310 BYTE (4)1,1,1,1,1,1,1,1,1
00320 BYTE (4)1,1,1,1,1,1,0,0,13
00330 BYTE (4)13,4
00010 SUBTTL INITIALIZE LOADING OF A FILE
00020
00030 ILD: MOVEI W,BUF1 ;LOAD BUFFER ORIGIN
00040 MOVEM W,.JBFF
00050 TLOE F,ISW ;SKIP IF INIT REQUIRED
00060 JRST ILD6 ;DONT DO INIT
00070 ILD7: OPEN 1,OPEN3 ;KEEP IT PURE
00080 JRST ILD5B
00090 ILD6: TLZE F,REWSW ;SKIP IF NO REWIND
00100 MTAPE 1,1 ;REWIND
00110 ILD2: LOOKUP 1,DTIN ;LOOK UP FILE FROM DIRECTORY
00120 JRST ILD3 ;FILE NOT IN DIRECTORY
00130 IFE LNSSW,<
00140 INBUF 1,BUFN ;SET UP BUFFERS>
00150 IFN LNSSW,<INBUF 1,1
00160 MOVEI W,BUF1
00170 EXCH W,.JBFF
00180 SUBI W,BUF1
00190 IFE K,<MOVEI C,4*203+1>
00200 IFN K,<MOVEI C,203+1>
00210 IDIV C,W
00220 INBUF 1,(C)>
00230 TLO F,ASW ;SET LEFT ARROW ILLEGAL FLAG
00240 TLZ F,ESW ;CLEAR EXTENSION FLAG
00250 POPJ P,
00260
00270 ; LOOKUP FAILURE
00280
00290 ILD3: TLOE F,ESW ;SKIP IF .REL WAS ASSUMED
00300 JRST ILD4 ;FATAL LOOKUP FAILURE
00310 SETZM DTIN1 ;ZERO FILE EXTENSION
00320 JRST ILD2 ;TRY AGAIN WITH NULL EXTENSION
00330
00340 ILD4:
00350 IFN CPUSW,< ;ALLOW LIB40I OR LIB40A TO FIND LIB40
00360 MOVE W,DTIN ;GET NAME WE TRIED FOR
00370 TRZN W,77 ;DELETE 6TH CHARACTER
00380 JRST ILD4B ;TRIED ALL CASES IF NULL
00390 IFN REENT,<CAME W,['IMP40 '] ;IMP40? REQUESTED?>
00400 CAMN W,['LIB40 '] ;WAS IT SOME FLAVOUR OF LIB40?
00410 JRST [MOVEM W,DTIN ;YES, SALT NEW NAME
00420 PUSHJ P,LDDT2 ;SET .REL AGAIN
00430 TLZ F,ESW
00440 JRST ILD2]
00450 ILD4B:>
00460 IFE REENT,<IFE TEN30,< ;PDP-6 ONLY
00470 MOVE W,[SIXBIT /LIB40/]
00480 CAME W,DTIN ;WAS THIS A TRY FOR LIB40?
00490 JRST ILD4A ;NO
00500 TRZ W,(SIXBIT / 0/) ;YES
00510 MOVEM W,DTIN ;TRY LIB4
00520 PUSHJ P,LDDT2 ;USE .REL EXTENSION
00530 TLZ F,ESW ;...
00540 JRST ILD2 ;GO TRY AGAIN
00550 ILD4A:>>
00560
00570 ILD9: ERROR ,</CANNOT FIND#/>
00580 JRST LD2C
00590
00600 ; DEVICE SELECTION ERROR
00610
00620 ILD5A: SKIPA W,LD5C1
00630 ILD5B: MOVE W,ILD1
00640 ILD5: PUSHJ P,PRQ ;START W/ ?
00650 PUSHJ P,PWORD ;PRINT DEVICE NAME
00660 ERROR 7,</UNAVAILABLE@/>
00670 JRST LD2
00010 SUBTTL LIBRARY SEARCH CONTROL AND LOADER CONTROL
00020
00030 LIBF0: IFN FORSW,<
00040 JUMPE D,LIBF ;MAKE /F WORK SAME WAY
00050 SOSGE D ;USER SUPPLIED VALUE?
00060 MOVEI D,FORSW-1 ;NO, SUPPLY DEFAULT
00070 MOVEM D,FORLIB ;STORE VALUE
00080 POPJ P, ;RETURN HAVING SETUP FOR /0F>
00090
00100 LIBF: PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION
00110 PUSH P,ILD1 ;SAVE DEVICE NAME
00120 IFN PP,<SETZM PPN ;CLEAR LOCAL PPN
00130 SETZM PPPN ;AND GLOBAL PPN>
00140 PUSHJ P,LIBF1 ;LOAD SYS:JOBDAT.REL
00150 IFN SAILSW,<LIBAGN: PUSHJ P,SALOAD ;LOAD RELS AND SEARCH LIBS>
00160 IFN REENT,<SKIPGE W,VSW ;WAS /-V SEEN
00170 TRZ N,VFLG ;YES, DOES NOT WANT REENTRANT SYSTEM
00180 CAILE W,0 ;SKIP IF HE DOESN'T KNOW OR CARE
00190 TRO N,VFLG ;DEFINITELY WANTS REENTRANT SYSTEM
00200 TRNE F,SEENHI!HISYM ;IF ANY HISEG LOADED NO RE-ENT OP SYSTEM
00210 TRZ N,VFLG!MANTFL ;YES, SO FORCE /-V SWITCH
00220 TRNN N,VFLG
00230 JRST LIBF3
00240 IFN ALGSW,<TRNE N,ALGFL ;SPECIAL ACTION IF LOADING ALGOL
00250 PUSHJ P,SHARE>
00260 IFN FORSW,<TRNN N,FORFL ;FORTRAN-10 ALWAYS WANTS FOROTS
00270 TRNE N,F4FL ;IF F40
00280 SKIPG FORLIB ;AND WANTING FORLIB
00290 JRST LIBF3 ;NOT BOTH TRUE
00300 MOVE C,[RADIX50 04,FOROT%] ;SYMBOL
00310 MOVEI W,400000+.JBHDA ;VALUE
00320 PUSHJ P,SYMPT ;YES, DEFINE SYMBOL>
00330 LIBF3:>
00340 IFN NELSW,<TRNN N,NELFL ;LOADING NELIAC
00350 JRST .+4 ;NO
00360 PUSHJ P,NELGO ;UNDEFINED SYMBOL NELGO
00370 MOVE W,[SIXBIT /LIBNEL/]
00380 PUSHJ P,LIBF2 ;LOAD NELIAC LIBRARY>
00390 IFN ALGSW,<MOVE W,[SIXBIT /ALGLIB/]
00400 IFE NAMESW,<TRNE N,ALGFL ;LOADING ALGOL?>
00410 IFN NAMESW,<TRNN N,ALGFL ;ALGOL?
00420 JRST LIBF5+1 ;NO
00430 SKIPE CURNAM ;SEE MAIN PROG YET?
00440 JRST LIBF5 ;YES
00450 ERROR ,</ALGOL MAIN PROGRAM NOT LOADED!/>
00460 EXIT
00470 LIBF5:>
00480 PUSHJ P,LIBF2 ;YES, LOAD LIBRARY>
00490 IFN COBSW,<MOVE W,[SIXBIT /LIBOL/]
00500 TRNE N,COBFL ;LOADING COBOL?
00510 PUSHJ P,LIBF2 ;YES, SCAN LIBOL>
00520 IFN REENT,<
00530 IFE CPUSW,<MOVE W,[SIXBIT /IMP40/]>
00540 IFN CPUSW,<MOVE W,['IMP40A'] ;ASSUME KA-10
00550 TRNE F,KICPFL ;BUT IS IT?
00560 HRRI W,'40I' ;NO, CHANGE TO IMP40A>
00570 IFN FORSW,<SKIPG FORLIB ;IF LOADING FORLIB WE DON'T WANT IMP40>
00580 TRNE N,COMFLS-F4FL ;ANY OTHER COMPILER ?
00590 JRST LIBF4 ;YES, THEN WE DON'T WANT IMP40
00600 TRNE N,VFLG ;WANT REENTRANT OP SYSTEM?
00610 PUSHJ P,LIBF2 ;YES, TRY REENTRANT FORSE>
00620 LIBF4:
00630 IFE CPUSW,<MOVE W,[SIXBIT /LIB40/]>
00640 IFN CPUSW,<MOVE W,['LIB40A']
00650 TRNE F,KICPFL
00660 HRRI W,'40I'>
00670 IFN FORSW,<SKIPLE FORLIB ;FORSE OR FOROTS
00680 MOVE W,['FORLIB'] ;YOU GET WHAT YOU ASK FOR>
00690 IFN ALGSW,<TRNN N,ALGFL ;DON'T NEED LIB40 FOR ALGOL>
00700 PUSHJ P,LIBF2 ;LOAD LIBRARY
00710 IFN SAILSW,<MOVE W,LIBPNT ;SEE IF ANY MORE TO DO
00720 CAME W,[XWD -RELLEN-1,LIBFLS-1]
00730 JRST LIBAGN
00740 MOVE W,PRGPNT ;IT COULD BE DANGEROUS TO LOAD PROGRAMS HERE
00750 CAME W,[XWD -RELLEN-1,PRGFLS-1]
00760 JRST LIBAGN ;MORE TO DO, TRY AGAIN>
00770 POP P,ILD1 ;CALL TO LDDT1 WILL PUT IT IN OLDDEV
00780 LIBF1: MOVE W,[SIXBIT /JOBDAT/] ;LOAD SYS:JOBDAT.REL
00790 LIBF2: PUSHJ P,LDDT1
00800 LIBGO: JUMPGE S,EOF2 ;JUMP IF NO UNDEFINED GLOBALS
00810 TLO F,SLIBSW+SKIPSW ;ENABLE LIBRARY SEARCH
00820 TLZ F,SYMSW ;DISABLE LOADING WITH SYMBOLS
00830 JRST LDF ;INITIALIZE LOADING LIB4
00840 IFN ALGSW!NELSW,<
00850 IFN NELSW,<
00860 NELGO: SKIPA C,[RADIX50 60,%NELGO]>
00870 SHARE: MOVE C,[RADIX50 60,%SHARE]
00880 MOVEI W,0
00890 JRST SYMPT ;DEFINE IT >
00010 ; LIB CONTROLS THE LIBRARY SEARCH OF ONE FILE
00020
00030 LIB: JUMPGE S,EOF1 ;JUMP IF NO UNDEFINED GLOBALS
00040 TLO F,SKIPSW ;SET SKIPSW TO IGNORE MODE
00050 IFN DIDAL,<TRNE F,XFLG ;INDEX IN CORE?
00060 JRST INDEX1 ;YES>
00070 JRST LOAD ;CONTINUE LIB. SEARCH
00080
00090 LIB1: CAIE A,4 ;TEST FOR ENTRY BLOCK
00100 JRST LIB29 ;NOT AN ENTRY BLOCK, IGNORE IT
00110 LIB2: PUSHJ P,RWORD ;READ ONE DATA WORD
00120 MOVE C,W
00130 TLO C,040000 ;SET CODE BITS FOR SEARCH
00140 PUSHJ P,SREQ
00150 TLZA F,SKIPSW ;REQUEST MATCHES ENTRY, LOAD
00160 JRST LIB2 ;NOT FOUND
00170 LIB3: PUSHJ P,RWORD ;READ AND IGNORE ONE DATA WORD
00180 JRST LIB3 ;LOOP TO IGNORE INPUT
00190
00200 LIB29: CAIN A,14 ;INDEX BLOCK?
00210 JRST INDEX0 ;YES
00220 LIB30: HRRZ C,W ;GET WORD COUNT
00230 JUMPE C,LOAD1 ;IF NUL BLOCK RETURN
00240 CAILE C,↑D18 ;ONLY ONE SUB-BLOCK
00250 JRST LIB3 ;NO,SO USE OLD SLOW METHOD
00260 ADDI C,1 ;ONE FOR RELOCATION WORD
00270
00280 LIB31: CAML C,BUFR2 ;DOES BLOCK OVERLAP BUFFERS?
00290 SOJA C,LIB32 ;YES,ALLOW FOR INITIAL ILDB
00300 ADDM C,BUFR1 ;ADD TO BYTE POINTER
00310 MOVNS C ;NEGATE
00320 ADDM C,BUFR2 ;TO SUBTRACT C FROM WORD COUNT
00330 JRST LOAD1 ;GET NEXT BLOCK
00340
00350 LIB32: SUB C,BUFR2 ;ACCOUNT FOR REST OF THIS BUFFER
00360 PUSHJ P,WORD+1 ;GET ANOTHER BUFFERFUL
00370 JRST LIB31 ;TRY AGAIN
00010 IFN SAILSW,<
00020
00030 COMMENT * BLOCK TYPE 16 AND 17 USED TO SPECIFY PROGRAMS AND
00040 LIBRARIES WHICH MUST BE LOADED (SEARCHED) IF THE PROGRAM
00050 IN WHICH THE BLOCK APPEARS IS LOADED. IT IS NOW TIME TO
00060 LOAD AND SEARCH THESE FILES. IF ANY MAKE REQUESTS, THEY ARE ADDED
00070 TO THE END. WE WILL COME BACK AND LOOK AGAIN IN CASE A
00080 LIBRARY PROGRAM LOAD A REL PROGRAM. ORIGINAL CODE BY DCS*
00090
00100 SALOAD: MOVE T,[XWD -RELLEN-1,PRGFLS-1] ;TO RESET WITH AT END
00110 MOVEI D,PRGPNT ;OINTER TO UPPER LIMIT
00120 PUSHJ P,PRGPRG ;LOAD THEM IF ANY
00130
00140 ;NOW FOR LIBRARY SEARCH
00150
00160 MOVE T,[XWD -RELLEN-1,LIBFLS-1]
00170 MOVEI D,LIBPNT
00180
00190 PRGPRG: MOVEM D,LODLIM# ;SAVE POINTER TO LIMIT
00200 MOVEM T,LODSTP# ;START FOR RESETTING
00210 PRGBAK: MOVEM T,LODPNT# ;AND START
00220 CAMN T,@LODLIM ;GOTTEN TO END YET?
00230 JRST PRGDON ;YES, DUMP IT
00240 SKIPN W,PRGDEV(T) ;IS DEVICE SPECIFIED?
00250 MOVSI W,(SIXBIT /DSK/) ;NO, DSK
00260 MOVEM W,ILD1 ;WHERE WE INIT FROM
00270 MOVSI W,(SIXBIT /REL/) ;EXTENSION
00280 MOVEM W,DTIN1
00290 MOVE W,PRGFIL(T)
00300 MOVEM W,DTIN ;FILE NAME
00310 MOVE W,PRGPPN(T) ;THE PROJECT PROG
00320 MOVEM W,DTIN+3
00330 PUSH P,JRPRG ;A RETURN ADDRESS
00340 TLZ F,ISW ;FORCE NEW INIT
00350 HRRZ T,LODLIM
00360 CAIN T,LIBPNT ;WHICH ONE
00370 JRST LIBGO
00380 JRST LDF
00390 PRGRET: MOVE T,LODPNT ;RETURNS HERE, GET NEXT ONE
00400 AOBJN T,PRGBAK
00410
00420 PRGDON: MOVE T,LODSTP ;RESTE POINTER IN CASE MORE ON OTHER LIBS
00430 MOVEM T,@LODLIM
00440 JRPRG: POPJ P,PRGRET ;PUSHED TO GET A RETURN ADDRESS
00450
00460 PRGFIL==1 ;REL INDEX FOR FILE NAMES
00470 PRGPPN==RELLEN+1 ;AND FOR PPNS
00480 PRGDEV==2*RELLEN+1 ;AND FOR DEVICES
00490 > ;END OF IFN SAILSW
00010 SUBTTL LDDT LOADS <SYS:DDT.REL> AND SETS SYMSW
00020
00030 LDDTX: TLO N,DDSW+EXEQSW ;T - LOAD AND GO TO DDT
00040 LDDT: ;/D - LOAD DDT
00050 IFN TENEX,<PUSH P,1
00060 PUSH P,3
00070 MOVEM 2,3 ; X = 2
00080 MOVSI 1,100001
00090 HRROI 2,[ASCIZ /<SUBSYS>UDDT.SAV/]
00100 GTJFN
00110 JRST LDDTQ
00120 PUSH P,1 ;DDT JFN
00130 MOVEI 1,400000
00140 GEVEC ;LOADER'S EV
00150 POP P,1
00160 PUSH P,2
00170 HRLI 1,400000 ;THIS FORK
00180 GET
00190 MOVEI 1,400000
00200 GEVEC ;DDT'S EV
00210 MOVEM 2,.JBDDT(3) ;3 HAS X IN IT
00220 POP P,2
00230 SEVEC ;RESTORE LOADER'S EVEC
00240 TLO F,SYMSW!RMSMSW ;DO /S PROBABLY ON BY DEFAULT
00250 MOVE 2,3
00260 POP P,3
00270 POP P,1
00280 JRST DMN2
00290
00300 LDDTQ: TTCALL 3,[ASCIZ /
00310 DDT10X NOT AVAILABLE. USING DEC DDT./]
00320 MOVE 2,3
00330 POP P,3
00340 POP P,1>
00350 IFN DMNSW,< PUSH P,D ;SAVE INCASE /NNND >
00360 PUSHJ P,FSCN1 ;FORCE SCAN TO COMPLETION
00370 MOVSI W,'DDT' ;FILE IDENTIFIER <DDT>
00380 TLZ F,SYMSW!RMSMSW ;DON'T LOAD DDT WITH LOCAL SYMBOLS
00390 PUSHJ P,LDDT1
00400 PUSHJ P,LDF ;LOAD <SYS:DDT.REL>
00410 TLO F,SYMSW!RMSMSW ;ENABLE LOADING WITH SYMBOLS
00420 IFN DMNSW,< POP P,D ;RESTORE D
00430 JRST DMN2 ;MOVE SYMBOL TABLE >
00440 IFE DMNSW,< POPJ P,>
00450
00460 LDDT1: MOVEM W,DTIN ;STORE FILE IDENTIFIER
00470 MOVE W,ILD1 ;SAVE OLD DEV
00480 MOVEM W,OLDDEV
00490 IFN PP,<SETZM PPPN ;CLEAR PERM PPN>
00500 MOVSI W,'SYS' ;DEVICE IDENTIFIER <SYS>
00510 MOVEM W,ILD1 ;STORE DEVICE IDENTIFIER
00520 TLZ F,ISW+LIBSW+SKIPSW+REWSW ;CLEAR OLD FLAGS
00530 LDDT2: MOVSI W,'REL' ;EXTENSION IDENTIFIER <.REL>
00540 LDDT3: MOVEM W,DTIN1 ;STORE EXTENSION IDENTIFIER
00550 LDDT4: IFN PP,<
00560 PUSH P,W ;SAVE W
00570 SKIPN W,PPN ;GET TEMP PPN
00580 MOVE W,PPPN ;TRY PERM
00590 MOVEM W,DTIN+3 ;SET PPN
00600 POP P,W ;RESTORE W>
00610 POPJ P,
00010 SUBTTL EOF TERMINATES LOADING OF A FILE
00020
00030 EOF: MOVE P,PDSAV ;RESTORE PUSHDOWN POINTER
00040 EOF1: TLZ F,SLIBSW!SKIPSW ;CLEAR ONE FILE LIB. SEARCH FLAG
00050 IFN DIDAL,<TRZ F,XFLG!LSTLOD ;CLEAR DIDAL FLAGS
00060 IFN SYMDSW,<TRNE F,LSYMFL ;USING AUX BUF FOR LOCAL SYMBOLS?
00070 JRST EOF2 ;YES>
00080 MOVSI W,(1B0) ;FOOL MONITOR THAT WE HAVE NOT USED THIS BUFFER
00090 HLLM W,ABUF ;THEN NEXT OUTPUT WILL BE A "DUMMY OUTPUT"
00100 MOVSI W,700 ;RESET BYTE POINTER TO ASCII
00110 MOVEM W,ABUF1 ;AND HOPE DUMMY OUTPUT WILL CLEAR DIDAL STUFF
00120 SETZM ABUF2 ;ZERO BYTE COUNT TO FORCE DUMMY OUTPUT>
00130 EOF2: TLNE F,RMSMSW ;IF REMEMBER LOADING WITH SYMBOLS IS ON
00140 TLO F,SYMSW ;THEN RESTORE SYMBOL LOADING STATE
00150 POPJ P,
00160
00170 ; FORCE SCAN TO COMPLETION, LOAD IF NECESSARY
00180
00190 FSCN: PUSHJ P,FSCN1 ;FORCED LOAD BEFORE TEST
00200 TLNN F,FULLSW ;TEST FOR OVERLAP
00210 POPJ P, ;NO OVERLAP, RETURN
00220 MOVE W,H ;FETCH CORE SIZE REQUIRED
00230 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00240 MOVE W,DIEND ;YES, GET END OF BUFFER+1>
00250 SUBI W,1(S) ; COMPUT DEFICIENCY
00260 JUMPL W,EOF2 ;JUMP IF NO OVERLAP
00270 PUSHJ P,PRQ ;START WITH ?
00280 PUSHJ P,PRNUM0 ;INFORM USER
00290 ERROR 7,</WORDS OF OVERLAP#/>
00300 JRST LD2 ;ERROR RETURN
00310
00320 IFN SPCHN,<FSCN1A: TLNN F,NSW
00330 PUSHJ P,LIBF>
00340 FSCN1: TLON F,FSW ;SKIP IF NOT FIRST CALL TO FSCN
00350 FSCN2: TLNN F,CSW+DSW+ESW ;TEST SCAN FOR COMPLETION
00360 POPJ P,
00370 PUSHJ P,LD5B1 ;STORE FILE OR EXTENSION IDENT.
00380
00390 ; LOADER CONTROL, NORMAL MODE
00400
00410 LDF: PUSHJ P,ILD ;INITIALIZE LOADING
00420 TLNE F,LIBSW ;IN LIBRARY SEARCH MODE?
00430 JRST LIB ;CHECK IF NO UNDFS.
00010 SUBTTL LOAD SUBROUTINE
00020
00030 LOAD: MOVEM P,PDSAV ;SAVE PUSHDOWN POINTER
00040 IFN WFWSW,<SETZM VARLNG ;LENGTH OF VARIABLE AREA-ADDED TO RELOC>
00050 IFN ALGSW,<SETZM OWNLNG ;LENGTH OF OWN AREA-ADDED TO RELOC>
00060 IFN FAILSW,<SETZM LFTHSW ;RESET LOAD LEFT HALF FIXUP SW>
00070 IFN COBSW,<SETZM LOD37. ;CLEAR FLAG>
00080 IFN MANTIS,<TRZE N,SYMFOR ;ZERO LOAD SYMBOLS IF IT WAS FORCED
00090 TLZ F,SYMSW>
00100 IFN TENEX,<SETZM NLSTGL ;ALLOW UNDEF. GLOBALS TO LIST>
00110 LOAD1: MOVE P,PDSAV ;RESTORE PUSHDOWN POINTER
00120 LOAD1A: PUSHJ P,WORD ;INPUT BLOCK HEADER WORD
00130 MOVNI E,400000(W) ;WORD COUNT - FROM RH OF HEADER
00140 HLRZ A,W ;BLOCK TYPE - FROM LH OF HEADER
00150 IFN B11SW,<SKIPN POLSW ;ERROR IF STILL DOING POLISH>
00160 CAIL A,DISPL*2 ;TEST BLOCK TYPE NUMBER
00170 JRST LOAD4 ;ERROR, ILLEGAL BLOCK TYPE
00180 TLNE F,SKIPSW ;BLOCK OK - TEST LOAD STATUS
00190 JRST LIB1 ;RETURN TO LIB. SEARCH CONTROL
00200 HRRZ T,LOAD2(A) ;LOAD RH DISPATCH ENTRY
00210 CAIL A,DISPL ;SKIP IF CORRECT
00220 HLRZ T,LOAD2-DISPL(A);LOAD LH DISPATCH ENTRY
00230 TLNE F,FULLSW ;TEST CORE OVERLAP INDICATOR
00240 SOJG A,HIGH0 ;IGNORE BLOCK IF NOT TYPE 1
00250 JRST @T ;DISPATCH TO BLOCK SUBROUTINE
00260
00270 ;DISPATCH TABLE - BLOCK TYPES
00280 IFE B11SW,<POLFIX==LOAD4A>
00290 IFE FAILSW,<LINK==LOAD4A>
00300 IFE WFWSW,<LVARB==LOAD4A>
00310 IFE ALGSW,<ALGBLK==LOAD4A>
00320 IFE SAILSW,<LDPRG==LOAD4A
00330 LDLIB==LOAD4A>
00340 IFE COBSW,<COBSYM==LOAD4A>
00350
00360 LOAD2: COMML,,LIB30 ;20,,0
00370 SPDATA,,PROG ;21,,1
00380 LOAD4A,,SYM ;22,,2
00390 LOAD4A,,HISEG ;23,,3
00400 LOAD4A,,LIB30 ;24,,4
00410 LOAD4A,,HIGH ;25,,5
00420 LOAD4A,,NAME ;26,,6
00430 LOAD4A,,START ;27,,7
00440 LOAD4A,,LOCD ;30,,10
00450 LOAD4A,,POLFIX ;31,,11
00460 LOAD4A,,LINK ;32,,12
00470 LOAD4A,,LVARB ;33,,13
00480 LOAD4A,,INDEX ;34,,14
00490 LOAD4A,,ALGBLK ;35,,15
00500 LOAD4A,,LDPRG ;36,,16
00510 COBSYM,,LDLIB ;37,,17
00520
00530 DISPL==.-LOAD2
00540
00550 ;ERROR EXIT FOR BAD HEADER WORDS
00560
00570 LOAD4:
00580 IFN TENEX,<CAIN A,100 ;ASSIGN BLOCK?
00590 JRST ASGSYM ;YES>
00600 IFE K,<CAIN A,400 ;FORTRAN FOUR BLOCK
00610 IFN MANTIS,< JRST F4LD
00620 CAIE A,401 ;MANTIS DEBUGGER DATA PRESENT IN FORTRAN FILE
00630 JRST LOAD4A ;NO
00640 TLON F,SYMSW ;YES, FORCE SYMSW SET
00650 TRO N,SYMFOR>
00660 JRST F4LD>
00670
00680 LOAD4A: MOVE W,A ;GET BLOCK TYPE
00690 ERROR ,</ILL. FORMAT BLOCK TYPE !/>
00700 PUSHJ P,PRNUM ;PRINT BLOCK TYPE
00710 JRST ILC1 ;PRINT SUBROUTINE NAME
00010 SUBTTL LOAD PROGRAMS AND DATA (BLOCK TYPE 1)
00020 ;(BLOCK TYPE 37) TREAT AS BLOCK TYPE 1, BUT ONLY LOAD
00030 ;IF IN LOCAL SYMBOLS MODE
00040 IFN COBSW,<
00050 COBSYM: TLNN F,SYMSW ;LOCAL SYMBOLS?
00060 JRST LIB30 ;NO, SKIP OVER THIS BLOCK
00070 MOVEI V,-1(W) ;GET BLOCK LENGTH
00080 ADDM V,LOD37. ;COUNT EXTRA CODE>
00090
00100 PROG: MOVEI V,-1(W) ;LOAD BLOCK LENGTH
00110 PUSHJ P,RWORD ;READ BLOCK ORIGIN
00120 SKIPGE W
00130 PUSHJ P,PROGS ;SYMBOLIC IF 36 BITS
00140 ADD V,W ;COMPUTE NEW PROG. BREAK
00150 IFN REENT,<TLNN F,HIPROG
00160 JRST PROGLW ;NOT HIGH SEGMENT
00170 PROG3:
00180 IFN TENEX,<MOVE X,HIGHX>
00190 CAMGE W,HVAL1 ;CHECK TO SEE IF IN TOP SEG
00200 JRST LOWCOR
00210 MOVE T,.JBREL ;CHECK FOR OVERFLOW ON HIGH
00220 CAIL T,@X
00230 JRST PROG2
00240 PUSHJ P,HIEXP
00250 JRST FULLC
00260 JRST PROG3>
00270
00280 IFN MONLOD,<TLNN N,DISW ;LOADING TO DISK?
00290 JRST PROGLW ;NO, GO CHECK NEW BREAK
00300 CAMG H,V ;NEW BREAK?
00310 MOVE H,V ;YES, UPDATE
00320 JRST PROG2 ;NO NEED TO CHECK FOR ROOM>
00330 IFN REENT,<
00340 LOWCOR: SUB V,HIGHX ;RELOC FOR PROPER
00350 ADD V,LOWX ;LOADING OF LOW SEQMENT
00360 SUB W,HIGHX
00370 ADD W,LOWX>
00380 PROGLW: MOVEI T,@X
00390 CAMG H,T ;COMPARE WITH PREV. PROG. BREAK
00400 MOVE H,T
00410 TLNE F,FULLSW
00420 JRST FULLC ;NO ERROR MESSAGE
00430 IFN REENT,<CAML H,HVAL1
00440 JRST COROVL ;WE HAVE OVERFLOWED THE LOW SEGMENT
00450 CAMLE T,HILOW
00460 MOVEM T,HILOW ;HIGHEST LOW CODE LOADED INTO>
00470 CAILE H,1(S) ; SKIP IF SUFFICIENT CORE AVAILABLE
00480 IFN EXPAND,<JRST [PUSHJ P,XPAND>
00490 JRST FULLC
00500 IFN REENT,< TLNE F,HIPROG
00510 SUBI W,2000 ;HISEG LOADING LOW SEG>
00520 IFN EXPAND,< JRST .-1]>
00010 PROG2: MOVE V,W
00020 PROG1: PUSHJ P,RWORD ;READ DATA WORD
00030 IFN TEN30,<CAIN V,41 ;CHANGE FOR 10/30 JOBDAT
00040 MOVEI V,.JB41 ;JOB41 IS DIFFERENT
00050 CAIN V,74 ;SO IS JOBDAT
00060 MOVEI V,.JBDDT>
00070 IFN L,<CAML V,RINITL ;CHECK FOR BAD STORE>
00080 IFN MONLOD,<PUSHJ P,DICHK ;MAKE SURE ADDRESS IS IN CORE>
00090 MOVEM W,@X ;STORE DATA WORD IN PROG. AT LLC
00100 IFN MONLOD,<TLO N,WOSW ;SET SWITCH TO WRITE OUT BUFFER>
00110 AOJA V,PROG1 ;ADD ONE TO LOADER LOC. COUNTER
00120
00130 ;HERE TO FIND SYMBOLIC ORIGIN
00140 ;W CONTAINS RADIX50 60,ORIGIN
00150 ;NEXT WORD CONTAINS OFFSET
00160 ;NOTE SYMBOL MUST BE GLOBAL AND DEFINED
00170
00180 PROGS: MOVE C,W ;PUT SYMBOL IN CORRECT SEARCH AC
00190 TLC C,640000 ;PERMUTE FROM 60 TO 04
00200 PUSHJ P,SDEF ;SEE IF DEFINED
00210 SKIPA C,2(A) ;YES, GET VALUE
00220 JRST PROGER ;NO, GIVE WARNING
00230 HRRZ C,C ;CLEAR LEFT HALF IN CASE COMMON
00240 PUSHJ P,RWORD ;GET NEXT WORD
00250 ADD W,C ;FORM ORIGIN
00260 SOJA V,CPOPJ ;BUT NOT SO MANY DATA WORDS
00270
00280 PROGER: MOVEM C,(P) ;REMOVE RETURN, SAVE C
00290 ERROR ,</VALUE NOT DEFINED FOR SYMBOLIC RELOCATION COUNTER !/>
00300 POP P,C
00310 PUSHJ P,PRNAME
00320 JRST LIB3 ;IGNORE THIS BLOCK
00330
00010 SUBTTL LOAD SYMBOLS (BLOCK TYPE 2)
00020
00030 SYM: PUSHJ P,PRWORD ;READ TWO DATA WORDS
00040 PUSHJ P,SYMPT; PUT INTO TABLE
00050 IFN REENT,<PUSHJ P,RESTRX>
00060 JRST SYM
00070
00080 SYMPT: TLNE C,200000 ;GLOBAL REQUEST? WFW
00090 JUMPL C,SYM3 ;CHECK FOR 60 NOT JUST HIGH BIT WFW
00100 TLNN C,40000
00110 JRST SYM1A ;LOCAL SYMBOL
00120 TLNE C,100000
00130 JRST SYM1B
00140 SYMPTQ: PUSHJ P,SREQ ;GLOBAL DEF., SEARCH FOR REQUEST
00150 JRST SYM2 ;REQUEST MATCHES
00160 PUSHJ P,SDEF ;SEARCH FOR MULTIPLE DEFINITIONS
00170 JRST SYM1 ;MULTIPLY DEFINED GLOBAL
00180 JRST SYM1B
00190
00200 ; PROCESS MULTIPLY DEFINED GLOBAL
00210
00220 SYM1: CAMN W,2(A) ;COMPARE NEW AND OLD VALUE
00230 POPJ P,;
00240 AOS MDG ;COUNT MULTIPLY DEFINED GLOBALS
00250 PUSHJ P,PRQ ;START W/ ?
00260 PUSHJ P,PRNAM ;PRINT SYMBOL AND VALUE
00270 IFN RPGSW,<MOVE W,.JBERR ;RECORD THIS AS AN ERROR
00280 ADDI W,1
00290 HRRM W,.JBERR>
00300 MOVE W,2(A) ;LOAD OLD VALUE
00310 PUSHJ P,PRNUM ;PRINT OLD VALUE
00320 ERROR 7,</MUL. DEF. GLOBAL IN PROG. !/>
00330 MOVE C,SBRNAM ;GET PROGRAM NAME
00340 PUSHJ P,PRNAME ;PRINT R-50 NAME
00350 ERROR 0,</#/>
00360 POPJ P, ;IGNORE MUL. DEF. GLOBAL SYM
00010 ; LOCAL SYMBOL
00020
00030 SYM1A: TLNN F,SYMSW ;SKIP IF LOAD LOCALS SWITCH ON
00040 POPJ P,; IGNORE LOCAL SYMBOLS
00050 IFN SYMDSW,<
00060 IFE MONLOD,<TRNE F,LSYMFL ;ONLY PUT SYMBOLS ON DSK IF EXT SYM>
00070 IFN MONLOD,<TLNN N,DISW ;BUT NOT IF LOADING TO DISK>
00080 JRST SYM1X ;STORE SYMBOL ON DSK>
00090
00100 SYM1B: IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00110 PUSHJ P,SIZCHK ;YES, CHECK FOR OVERLAP>
00120 CAIL H,(S) ;STORE DEFINED SYMBOL
00130 IFN EXPAND,< PUSHJ P,XPAND7>
00140 IFE EXPAND,< JRST SFULLC>
00150 SYM1C: IFE K,<
00160 TLNE N,F4SW; FORTRAN FOUR REQUIRES A BLT
00170 PUSHJ P,MVDWN; OF THE TABLES>
00180 SYM1D: MOVEI A,-2(S) ;LOAD A TO SAVE INST. AT SYM2
00190 SUBI S,2 ;UPDATE UNDEFINED POINTER
00200 POP B,2(A) ;MOVE UNDEFINED VALUE POINTER
00210 POP B,1(A) ;MOVE UNDEFINED SYMBOL
00220 MOVEM W,2(B) ;STORE VALUE
00230 MOVEM C,1(B) ;STORE SYMBOL
00240 IFE SYMDSW,<POPJ P,>
00250 IFN SYMDSW,<
00260 SYM1X:
00270 IFN MONLOD,<SKIPL SYMEXT ;BEEN SETUP ONCE?
00280 TLNE N,DISW ;OR, IF OUTPUTTING TO DSK
00290 POPJ P, ;DON'T BOTHER>
00300 IFE MONLOD,<SKIPL SYMEXT ;BEEN SETUP ONCE?>
00310 TRNN F,LSYMFL ;OUTPUT FILE SET UP?
00320 IFN MONLOD,<PUSHJ P,INITSYM ;NO, DO IT>
00330 IFE MONLOD,<POPJ P, ;NO, DON'T OUTPUT SYMBOLS>
00340 SOSG ABUF2
00350 OUTPUT 2,
00360 IDPB C,ABUF1
00370 SOSG ABUF2
00380 OUTPUT 2,
00390 IDPB W,ABUF1
00400 AOS SYMCNT#
00410 POPJ P,>
00420
00010 IFN SYMDSW,<
00020 SYOPEN: HLRZM W,SYMEXT#
00030 MOVE W,DTIN ;GET FILE NAME
00040 MOVEM W,SYMNAM ;SAVE IT
00050 PUSHJ P,INITSYM ;OPEN FILE
00060 JRST LD2DD ;AND RETURN TO SCAN
00070
00080 INITSYM:
00090 TLZ N,AUXSWI!AUXSWE
00100 INIT 2,14
00110 SIXBIT /DSK/
00120 ABUF,,0
00130 HALT
00140 PUSH P,0
00150 PUSH P,1
00160 PUSH P,2
00170 PUSH P,3
00180 MOVEI 0,AUX
00190 MOVEM 0,.JBFF
00200 OUTBUF 2,1
00210 PJOB 0,
00220 MOVEI 3,3
00230 IDIVI 0,↑D10
00240 ADDI 1,"0"-40
00250 LSHC 1,-6
00260 SOJG 3,.-3
00270 HRRI 2,'SYM'
00280 MOVE 0,SYMNAM# ;GET NAME
00290 JUMPN 0,.+3 ;WAS IT SET
00300 MOVS 0,2 ;NO
00310 MOVEM 0,SYMNAM ;STORE IT
00320 SKIPN 1,SYMEXT ;ALREADY SET
00330 MOVEI 1,'TMP'
00340 HRRZM 1,SYMEXT ;STORE FILE EXTENSION
00350 HRLZS 1
00360 SETZB 2,3
00370 ENTER 2,0
00380 HALT
00390 POP P,3
00400 POP P,2
00410 POP P,1
00420 POP P,0
00430 IORI F,LSYMFL ;SYMBOL FILE SETUP NOW
00440 POPJ P,
00450 >
00010 ; GLOBAL DEFINITION MATCHES REQUEST
00020
00030 SYM2: PUSH P,SYM2C ;NEXT MUST BE A SUBROUTINE FOR LATER, SET RETURN
00040 SYM2B: MOVE V,2(A) ;LOAD REQUEST POINTER
00050 PUSHJ P,REMSYM
00060 JUMPL V,SYM2W ;ADDITIVE REQUEST? WFW
00070 PUSHJ P,SYM4A ;REPLACE CHAIN WITH DEFINITION
00080 SYM2W1: PUSHJ P,SREQ ;LOOK FOR MORE REQUESTS FOR THIS SYMBOL
00090 JRST SYM2B ;FOUND MORE
00100 SYM2C: POPJ P,SYM1D ;RETURN, SEE SYM2 FOR USE OF ADDRESS
00110
00120 ; REQUEST MATCHES GLOBAL DEFINITION
00130
00140 SYM2A: MOVE V,W ;LOAD POINTER TO CHAIN
00150 MOVE W,2(A) ;LOAD VALUE
00160 JUMPL V,FIXWP ;HANDLE ATTITIVE REQUEST WFW
00170 JRST SYM4A
00180
00190 ; PROCESS GLOBAL REQUEST
00200
00210 SYM3: TLNE C,040000; COMMON NAME
00220 JRST SYM1B
00230 TLC C,640000; PERMUTE BITS FROM 60 TO 04
00240 PUSHJ P,SDEF ;SEARCH FOR GLOBAL DEFINITION
00250 JRST SYM2A ;MATCHING GLOBAL DEFINITION
00260 JUMPL W,SYM3X1 ;ADDITIVE FIXUP WFW
00270 PUSHJ P,SREQ ;SEARCH FOR EXISTING REQUEST WFW
00280 JRST SYM3A ;EXISTING REQUEST FOUND WFW
00290 SYM3X1: TLNN W,100000 ;CHECK SYMBOL TABLE FIXUP
00300 JRST SYM3X2 ;NO
00310 MOVE V,1(B) ;MUST BE LAST SYMBOL DEFINED. GET SYMBOL
00320 XOR V,W ;CHECK FOR IDENTITY
00330 TDNE V,[XWD 77777,-1] ;BUT IGNORE HIGH 3 BITS
00340 POPJ P, ;NOT SAME, ASSUME NOT LOADED LOCAL
00350 HRRI W,2(B) ;GET LOCATION IN RIGHT HALF
00360 TLO W,1
00370 SUB W,HISTRT ;AND MAKE RELATIVE
00380 IFN B11SW,<TLZ W,040000>
00390 SYM3X2: IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00400 PUSHJ P,SIZCHK ;YES, CHECK FOR OVERLAP>
00410 CAIL H,(S) ;STORE REQUEST IN UNDEF. TABLE WFW
00420 IFN EXPAND,< PUSHJ P,XPAND7>
00430 IFE EXPAND,< JRST SFULLC>
00440 SYM3X: IFE K,<
00450 TLNE N,F4SW; FORTRAN FOUR
00460 PUSHJ P,MVDWN; ADJUST TABLES IF F4>
00470 SUB S,SE3 ;ADVANCE UNDEFINED POINTER
00480 MOVEM W,2(S) ;STORE UNDEFINED VALUE POINTER
00490 MOVEM C,1(S) ;STORE UNDEFINED SYMBOL
00500 POPJ P,;
00010
00020 ; COMBINE TWO REQUEST CHAINS
00030
00040 SYM3A: SKIPL 2(A) ;IS IT ADDITIVE WFW
00050 JRST SYM3A1 ;NO, PROCESS WFW
00060 SYM3A4: PUSHJ P,SDEF2 ;YES, CONTINUE WFW
00070 JRST SYM3A ;FOUND ANOTHER WFW
00080 JRST SYM3X2 ;REALLY NO CHAIN THERE WFW
00090 SYM3A1: SKIPE V,2(A) ;IF ADDRESS OF CHAIN IS 0, THROW IT AWAY
00100 JRST SYM3A2 ;AND USE THE NEW ONE, ELSE ADD THE CHAINS
00110 MOVEM W,2(A) ;W IS ADDRESS OF NEW CHAIN,STORE ON TOP OF OLD 0
00120 POPJ P,
00130 SYM3A2:
00140 SYM3A3: MOVE A,2(A)
00150 SYM3B: HRRZ V,A
00160 IFN L,<CAMGE V,RINITL
00170 HALT>
00180 IFN REENT,<CAMGE V,HVAL1
00190 SKIPA X,LOWX
00200 MOVE X,HIGHX>
00210 IFN MONLOD,<PUSHJ P,DICHK ; MAKE SURE ADDRESS IN V IS IN CORE>
00220 HRRZ A,@X ; LOAD NEXT ADDRESS IN CHAIN
00230 JUMPN A,SYM3B ; JUMP IF NOT THE LAST ADDR. IN CHAIN
00240 HRRM W,@X ;COMBINE CHAINS
00250 IFN MONLOD,<TLO N,WOSW ;SET FLAG TO WRITE OUT BUFFER>
00260 POPJ P,;
00270
00280 ;WFW PATCH FOR ADDITIVE GLOBAL REQUESTS
00290
00300 FIXWP: TLNN V,100000 ;CHECK FOR SYMBOL TABLE FIXUP
00310 JRST FIXW
00320 MOVE T,1(B) ;SYMBOL FIXUP, MUST BE LAST SYMBOL DEFINED
00330 XOR T,V ;CHECK FO SAME
00340 TDNE T,[XWD 77777,-1] ;EXCEPT FOR HIGH CODE BITS
00350 POPJ P, ;ASSUME NON-LOADED LOCAL
00360 HRRI V,2(B) ;GET LOCATION
00370 SUBI V,(X) ;SO WE CAN USE @X
00380 JRST FIXW1
00390 FIXW: IFN REENT,<HRRZ T,V
00400 CAMGE T,HVAL1
00410 SKIPA X,LOWX
00420 MOVE X,HIGHX>
00430 IFN L,< HRRZ T,V
00440 CAMGE R,RINITL
00450 POPJ P,>
00460 FIXW1: TLNE V,200000 ;IS IT LEFT HALF
00470 JRST FIXWL
00480 IFN MONLOD,<TLNN V,100000 ;SKIP IF USING @X TO FIX SYMBOL TABLE
00490 PUSHJ P,DICHK ;MAKE SURE ADDRESS IN V IS IN CORE>
00500 MOVE T,@X ;GET WORD
00510 ADD T,W ;VALUE OF GLOBAL
00520 HRRM T,@X ;FIX WITHOUT CARRY
00530 IFN MONLOD,<TLNN V,100000 ;SKIP IF JUST FIXED SYMBOL TABLE
00540 TLO N,WOSW ;SET FLAG TO WRITE OUT BUFFER>
00550 MOVSI D,200000 ;SET UP TO REMOVE DEFERED INTERNAL IF THERE
00560 JRST SYMFIX
00010 FIXWL: HRLZ T,W ;UPDATE VALUE OF LEFT HALF
00020 IFN MONLOD,<TLNN V,100000 ;SKIP IF USING @X TO FIX SYMBOL TABLE
00030 PUSHJ P,DICHK ;MAKE SURE ADDRESS IN V IS IN CORE>
00040 ADDM T,@X ;BY VALUE OF GLOBAL
00050 IFN MONLOD,<TLNN V,100000 ;SKIP IF JUST FIXED SYMBOL TABLE
00060 TLO N,WOSW ;SET FLAG TO WRITE OUT BUFFER>
00070 MOVSI D,400000 ;LEFT DEFERED INTERNAL
00080 SYMFIX: TLNN V,100000 ;CHECK FOR SYMBOL TABLE FIXUP
00090 POPJ P, ;NO, RETURN
00100 ADDI V,(X) ;GET THE LOCATION
00110 SYMFX1: MOVE T,-1(V) ;GET THE SYMBOL NAME
00120 TLNN T,40000 ;CHECK TO SEE IF INTERNAL
00130 POPJ P, ;NO, LEAVE
00140 ANDCAB D,-1(V) ;REMOVE PROPER BIT
00150 TLNE D,600000 ;IS IT STILL DEFERED?
00160 POPJ P, ;YES, ALL DONE
00170 EXCH C,D ;NO, CHECK FOR A REQUEST FOR IT
00180 PUSHJ P,SREQ
00190 JRST CHNSYM ;YES, WILL HAVE TO CALL THE FIXUP ROUTINE
00200 MOVE C,D ;GET C BACK
00210 POPJ P,
00220 CHNSYM: PUSH P,D ;HAS THE OLD C IN IT
00230 PUSH P,W ;WE MAY NEED IT LATER
00240 MOVE W,(V) ;GET VALUE
00250 PUSHJ P,SYM2B ;CALL THE FOUND GLOBAL TO MATCH REQUEST ROUTINE
00260 POP P,W
00270 POP P,C ;RESTORE FOR CALLER
00280 POPJ P, ;AND GO AWAY
00290
00300 SYM2W: IFN B11SW,<
00310 TLNE V,40000 ;CHECK FOR POLISH
00320 JRST POLSAT>
00330 TLNN V,100000 ;SYMBOL TABLE?
00340 JRST SYM2WA
00350 ADD V,HISTRT ;MAKE ABSOLUTE
00360 SUBI V,(X) ;GET READY TO ADD X
00370 PUSHJ P,FIXW1
00380 JRST SYM2W1
00390 SYM2WA: PUSHJ P,FIXW ;DO FIXUP
00400 JRST SYM2W1 ;AND LOOK FOR MORE REQUESTS
00410
00420 ;END WFW PATCH
00010 ;PATCH VALUES INTO CHAINED REQUEST
00020
00030 SYM4: IFN L,<CAMGE V,RINITL
00040 POPJ P,>
00050 IFN REENT,<CAMGE V,HVAL1
00060 SKIPA X,LOWX
00070 MOVE X,HIGHX>
00080 IFN MONLOD,<PUSHJ P,DICHK ;MAKE SURE ADDRESS IN V IS IN CORE>
00090 HRRZ T,@X ;LOAD NEXT ADDRESS IN CHAIN
00100 HRRM W,@X ;INSERT VALUE INTO PROGRAM
00110 IFN MONLOD,<TLO N,WOSW ;SET FLAG TO WRITE OUT BUFFER>
00120 MOVE V,T
00130 SYM4A: JUMPN V,SYM4 ;JUMP IF NOT LAST ADDR. IN CHAIN
00140 POPJ P,
00150
00160 IFE K,<
00170 MVDWN: HRRZ T,MLTP
00180 IFN EXPAND,< SUBI T,2>
00190 CAIG T,(H); ANY ROOM LEFT?
00200 IFN EXPAND,< JRST [PUSHJ P,XPAND>
00210 TLOA F,FULLSW
00220 IFN EXPAND,< JRST MVDWN
00230 POPJ P,]>
00240 TLNE F,SKIPSW+FULLSW
00250 POPJ P, ; ABORT BLT
00260 HRREI T,-2
00270 ADDM T,PLTP; ADJUST PROGRAMMER LABEL POINTER
00280 ADDM T,BITP; AND BIT TABLE POINTER
00290 ADDM T,SDSTP; FIRST DATA STATEMENT
00300 ADDM T,LTC
00310 ADDM T,ITC
00320 TLNE N,SYDAT
00330 ADDM T,V
00340 ADDB T,MLTP; AND FINALLY TO MADE LABEL TABLE
00350 HRLS T; SET UP BLT POINTER
00360 ADD T,[XWD 2,0]
00370 BLT T,(S)
00380 POPJ P,
00390 >
00400 REMSYM: MOVE T,1(S)
00410 MOVEM T,1(A)
00420 MOVE T,2(S)
00430 MOVEM T,2(A)
00440 CAIN S,A ;MOVING TO SELF?
00450 JRST REMSY1 ;YES, DON'T CLEAR
00460 SETZM 1(S) ;CLEAR NAME
00470 SETZM 2(S) ;CLEAR POINTER
00480 REMSY1: ADD S,SE3
00490 POPJ P,
00500
00010 SUBTTL HIGH-SEGMENT (BLOCK TYPE 3)
00020 ;THIS PROGRAM IS INTENDED FOR HI SEGMENT IF RUNNING ON A PDP-10.
00030 ; THIS BLOCK TYPE OCCURS AFTER ENTRY AND NAME BLOCKS.
00040
00050 HISEG: HRRZ C,W ;GET WORD COUNT
00060 PUSHJ P,WORD ;GOBBLE UP BYTE WORD.
00070 PUSHJ P,WORD ;GET THE HIGH SEG OFSET
00080 SOJE C,.+4 ;FINISHED IF NOT FORTRAN-10
00090 MOVE C,W ;SAVE HIGH INFO
00100 PUSHJ P,WORD ;GET LOW BREAK
00110 EXCH W,C ;SWAP BACK
00120 IFE REENT,<HISEG2==LOAD1A
00130 JUMPGE W,LOAD1A ;NOT TWO SEG PROG.>
00140 IFN REENT,<JUMPE W,HISEG2 ;IGNORE ZERO
00150 IFE TENEX,<JUMPG W,HISEG3 ;NEG. IF TWOSEG PSEUDO-OP>
00160 IFN TENEX,<TLNN W,-1
00170 JRST HISEG3>
00180 >;END OF IFN REENT
00190 TRO F,TWOFL ;SET FLAG
00200 IFN REENT,<
00210 TRNE F,NOHI!NOHI6 ;TWO SEGMENTS LEGAL?
00220 JRST ONESEG ;LOAD AS ONE SEGMENT
00230 HISEG3: HRRZ D,W ;GET START OF HISEG
00240 JUMPE D,.+2 ;NOT SPECIFIED
00250 PUSHJ P,HCONT ;AS IF /H
00260 HISEG2: PUSHJ P,HISEG1
00270 JRST LOAD1 ;GET NEXT BLOCK
00280 FAKEHI: ;AS IF BLOCK TYPE 3
00290 HISEG1: TRNE F,NOHI!NOHI6 ;LOAD REENT?
00300 POPJ P,
00310 TLOE F,HIPROG ;LOADING HI PROG
00320 POPJ P, ;IGNORE 2'ND HISEG
00330 TRON F,SEENHI ;HAVE WE LOADED ANY OTHER HI STUFF?
00340 PUSHJ P,SETUPH ;NO,SET UP HI SEG.
00350 MOVEM R,LOWR
00360 MOVE R,HIGHR
00370 MOVE X,NAMPTR ;GET THE POINTER TO PROGRAM NAME
00380 HRRM R,2(X) ;CALL THIS THE START OF THE PROGRAM
00390 MOVE X,HIGHX
00400 POPJ P,
00410
00420 SETUPH: MOVE X,HVAL1
00430 CAIGE X,-1 ;SEE IF IT HAS BEEN CHANGED FROM ORIG
00440 JRST SEENHS ;YES, MUST HAVE SEEN /H
00450 MOVEI X,400000
00460 MOVEM X,HVAL1
00470 CAIG X,(H) ;HAVE WE RUN OVER WITH THE LOW SEG
00480 JRST COROVL
00490 ADDI X,.JBHDA
00500 HRLI X,W
00510 MOVEM X,HVAL
00520 SEENHS: MOVE X,HVAL
00530 MOVEM X,HIGHR
00540 HRRZ X,.JBREL
00550 SUB X,HVAL1
00560 ADDI X,1
00570 HRLI X,V
00580 MOVEM X,HIGHX
00590 POPJ P,
00600
00010 SETSEG: TRZ F,NOHI!SEGFL ;ALLOW HI-SEG
00020 JUMPL D,.+2 ;/-H TURNS OFF NOHI ONLY
00030 TRO F,SEGFL ;/1H FORCES HI
00040 POPJ P,
00050 >
00060
00070 ONESEG: HLRZ D,W ;GET LENGTH OF HISEG
00080 SUBI D,(W) ;REMOVE OFSET
00090 JUMPLE D,ONELOW ;LENGTH NOT AVAILABLE
00100 MOVEM R,LOWR ;SAVE LOW SEGMENT RELOCATION
00110 ADDM D,LOWR ;ADD TO LOW SEG RELOCATION
00120 HRRZM W,HVAL1 ;SO RELOC WILL WORK
00130 JRST LOAD1 ;GET NEXT BLOCK
00140
00150 ONELOW: HLRZ D,C ;TRY LOW SEG BREAK
00160 SUBI D,(C)
00170 JUMPLE D,TWOERR ;NOT AVAILABLE
00180 MOVEM R,LOWR ;SAVE CURRENT BREAK
00190 ADD R,D ;ADD LOW LENGTH
00200 HRRZM W,HVAL1 ;SO RELOC WILL WORK
00210 JRST LOAD1
00220
00230 TWOERR: ERROR 7,</TWO SEGMENTS ILLEGAL#/>
00240 IFE L,< JRST LDRSTR>
00250 IFN L,< JRST LOAD1>
00010 SUBTTL HIGHEST RELOCATABLE POINT (BLOCK TYPE 5)
00020
00030 HIGH0: CAIE A,4 ; TEST FOR END BLOCK (OVERLAP)
00040 JRST LIB30
00050
00060 HIGH: TRNN F,TWOFL ;IS THIS A TWO SEGMENT PROGRAM?
00070 JRST HIGH2A ;NO
00080 HIGH2: PUSHJ P,RWORD ;GET HISEG BREAK
00090 TRZ F,TWOFL ;CLEAR FLAG NOW
00100 IFE REENT,<MOVE R,LOWR
00110 JRST HIGH2A>
00120 IFN REENT,<TRNE F,NOHI!NOHI6 ;SINGLE SEGMENT LOAD?
00130 JRST [MOVE R,LOWR ;YES,GET LARGER RELOC
00140 CAILE W,(R) ;IF FORTRAN-10
00150 SKIPA C,W ;HISEG CODE IS ON TOP
00160 SETZ C, ;OTHERWISE ZERO ABS VALUE
00170 MOVE W,HVAL ;ORIGINAL VALUE
00180 MOVEM W,HVAL1 ;RESET
00190 PUSHJ P,RWORD ;GET LOW SEG BREAK IN W
00200 CAMGE C,W ;PUT LARGER VALUE
00210 MOVE C,W ;IN C
00220 JRST HIGH2B] ;CONTINUE AS IF LOW ONLY
00230 HRR R,W ;PUT BREAK IN R
00240 CAMLE R,HVAL
00250 MOVEM R,HVAL
00260 MOVEM R,HIGHR
00270 MOVE R,LOWR ;NEXT WORD IS LOW SEG BREAK
00280 TLZ F,HIPROG ;CLEAR HIPROG
00290 PUSHJ P,PRWORD ;GET WORD PAIR
00300 HRR R,C ;GET LOW SEG BREAK
00310 MOVEM R,LOWR ;SAVE IT
00320 MOVE R,HIGHR ;GET HIGH BREAK
00330 JRST HIGHN3 ;AND JOIN COMMON CODE>
00340
00010 HIGH2A: PUSHJ P,PRWORD ;READ TWO DATA WORDS.
00020 HIGH2B: IFN REENT,<
00030 TLZE F,HIPROG
00040 JRST HIGHNP>
00050 IFN WFWSW,<ADD C,VARLNG ;IF LOW SEG THEN VARIABLES GO AT END>
00060 IFN ALGSW,<ADD C,OWNLNG ;ADD IN LENGTH OF OWN BLOCK>
00070 IFN COBSW,<ADD C,LOD37. ;ADD IN LOCAL SYMBOLS
00080 SKIPE LOD37. ;BUT WERE THERE ANY?
00090 SUBI C,3 ;YES SO REMOVE THE 3 WORDS OVERWRITTEN>
00100 IFE TENEX,<CAMGE C,W ;CHECK 2ND WORD (LOC PROG BRK IF PRESENT)
00110 MOVE C,W>
00120 HRR R,C ;SET NEW PROGRAM BREAK
00130 HIGH31: MOVEM R,LOWR ;SAVE NEW VALUE OF R
00140 IFN MONLOD,<TLNN N,DISW ;SKIP IF LOADING TO DISK>
00150 ADDI C,(X)
00160 CAIG H,(C)
00170 MOVEI H,(C) ;SET UP H
00180 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00190 JRST HIGH3 ;YES, DON'T WORRY ABOUT EXCEEDING CORE>
00200 CAILE H,1(S) ;TEST PROGRAM BREAK
00210 IFN EXPAND,<PUSHJ P,[ PUSHJ P,XPAND
00220 POPJ P,
00230 JRST POPJM2]>
00240 IFE EXPAND,<TLO F,FULLSW>
00250 HIGH3: MOVEI A,F.C
00260 BLT A,B.C
00270 IFN REENT,<TRNE F,NOHI!NOHI6 ;ONE SEGMENT PROGRAM?
00280 JRST HIGHN4 ;YES
00290 HRRZ W,LOWR ;GET LOW PROG BREAK
00300 HRL W,HIGHR ;GET HIGH PROG BREAK
00310 SETZ C, ;ZERO SYMBOL NAME
00320 PUSHJ P,SYM1B ;PUT IN SYMBOL TABLE
00330 MOVEM S,F.C+S ;SAVE NEW S AND B
00340 MOVEM B,F.C+B ;INCASE OF ERROR
00350 HIGHN4:>
00360 TRZE N,F10TFL ;FORTRAN-10 SET NOHI?
00370 TRZ F,NOHI ;YES, CLEAR IT
00380 SETZM SBRNAM ;RELAX, RELOCATION BLOCK FOUND
00390 TLNE F,SLIBSW+LIBSW ;NORMAL MODE EXIT THROUGH LOAD1
00400 JRST LIB ;LIBRARY SEARCH EXIT
00410 JRST LOAD1
00010 IFN REENT,<
00020 HIGHNP: HRR R,C
00030 CAMG W,HVAL1 ;ABS. ADDRESS IN HIGH SEGMENT?
00040 JRST HIGHN1 ;NO
00050 CAIG C,(W) ;YES, GREATER THAN CURRENT HISEG RELOC?
00060 HRR R,W ;YES, USE IT
00070 SETZ W, ;DON'T USE IT AGAIN
00080 HIGHN1: CAMLE R,HVAL
00090 MOVEM R,HVAL
00100 MOVEM R,HIGHR
00110 HIGHN3: PUSH P,W ;SAVE W,CONTAIN HIGHEST ABSOLUTE ADDRESS
00120 ADD W,LOWX ;LOC PROG BRK
00130 CAIGE H,(W) ;CHECK FOR TOP OF LOW CORE
00140 MOVEI H,(W)
00150 POP P,W ;RESTORE
00160 CAML H,HVAL1
00170 JRST COROVL ;OVERFLOW OF LOW SEGMENT
00180 HIGHN2: HRRZ R,HVAL
00190 SUB R,HVAL1
00200 ADD R,HISTRT
00210 CAMLE R,.JBREL
00220 JRST [PUSHJ P,HIEXP
00230 JRST FULLC
00240 JRST HIGHN2]
00250 MOVE R,LOWR
00260 MOVE X,LOWX
00270 IFN WFWSW,<ADD R,VARLNG ;VARIABLES IN LOW SEG>
00280 IFN ALGSW,<ADD R,OWNLNG ;OWN BLOCK IN LOW SEGMENT>
00290 IFN COBSW,<ADD R,LOD37. ;ADD IN LOCAL SYMBOLS
00300 SKIPE LOD37. ;BUT WERE THERE ANY?
00310 SUBI R,3 ;YES SO REMOVE THE 3 WORDS OVERWRITTEN>
00320 HRRZ C,R
00330 CAIGE C,(W) ;IS ABSOLUTE LOCATION GREATER
00340 HRR R,W ;YES USE IT
00350 HRRZ C,R ;SET UP C AGAIN
00360 JRST HIGH31 ;GO CHECK PROGRAM BREAK
00370 >
00380 SFULLC: TROE F,SFULSW ;PREVIOUS OVERFLOW?
00390 JRST FULLC ;YES, DON'T PRINT MESSAGE
00400 ERROR ,<?SYMBOL TABLE OVERLAP#?>
00410 FULLC:
00420 IFE K,< TLNE N,F4SW
00430 POPJ P,>
00440 JRST LIB3 ;LOOK FOR MORE
00010 SUBTTL EXPAND HIGH SEGMENT
00020
00030 IFN REENT,<
00040 HIEXP: TLNE F,FULLSW
00050 POPJ P,
00060 IFN EXPAND,<PUSH P,Q>
00070 PUSH P,H
00080 PUSH P,X
00090 PUSH P,N
00100 IFE K,<HRRZ X,MLTP
00110 TLNN N,F4SW>
00120 MOVEI X,1(S)
00130 HRRZ N,X
00140 SUB N,H
00150 CAILE N,1777
00160 JRST MOVHI
00170 IFE EXPAND,<POPJ P,>
00180 IFN EXPAND,<HRRZ N,.JBREL
00190 ADDI N,2000
00200 CAMG N,ALWCOR
00210 CORE N,
00220 JRST XPAND6
00230 POP P,N
00240 JRST XPAND3>
00250
00260 MOVHI: MOVEI N,-2000(X)
00270 HRL N,X
00280 HRRZ X,.JBREL
00290 BLT N,-2000(X)
00300 MOVNI H,2000
00310 IFN EXPAND,<JRST XPAND8>
00320 IFE EXPAND,<ADDM H,HISTRT
00330 ADDM H,S
00340 ADDM H,B
00350 ADDM H,HIGHX
00360 TLNE F,HIPROG
00370 ADDM H,-1(P)
00380 POP P,N
00390 ADDM H,NAMPTR ;ADJUST POINTER TO NAME
00400 IFE K,< TLNN F4SW
00410 JRST HIXP1
00420 ADDM H,PLTP
00430 ADDM H,BITP
00440 ADDM H,SDSTP
00450 ADDM H,MLTP
00460 TLNE N,SYDAT
00470 ADDM H,V
00480 HIXP1:>
00490 POP P,X
00500 POP P,H
00510 AOS (P)
00520 POPJ P,>
00530 >
00010 SUBTTL PROGRAM NAME (BLOCK TYPE 6)
00020
00030 NAME: SKIPE SBRNAM ;HAVE WE SEEN TWO IN A ROW?
00040 JRST NAMERR ;YES, NO END BLOCK SEEN
00050 NAME0: PUSHJ P,PRWORD ;READ TWO DATA WORDS
00060 MOVEM C,SBRNAM ;SAVE SUBROUTINE NAME
00070 IFN MANTIS,<CAMN C,[RADIX50 0,MANTIS]
00080 CAME R,[W,,.JBDA] ;YES, BUT IS IT TO LOAD AT 140?
00090 CAIA ;NO, NOT A DEBUG /MANTIS COMMAND
00100 TRO N,MANTFL ;HAVE SEEN MANTIS NOW>
00110 NCONT: HLRZ V,W ;GET COMPILER TYPE
00120 ANDI V,7777 ;BITS 6-17
00130 CAILE V,CMPLEN ;ONLY IF LEGAL TYPE
00140 SETZ V, ;MAKE DEFAULT
00150 HLL V,W ;GET CPU TYPE ALSO
00160 TLZ V,7777 ;BITS 0-5
00170 HRRZS W ;CLEAR TYPE
00180 XCT CMPLER(V) ;DO SPECIAL FUNCTION
00190 TLOE N,COMFLG ;SKIP IF COMMON NOT PREV. SET
00200 JRST NAME1 ;SIZE OF COMMON PREV. SET
00210 MOVEM W,COMSAV ;STORE LENGTH OF COMMON
00220 JUMPE W,NAME2 ;JUMP IF NO COMMON IN THIS JOB
00230 HRRI R,@R ;FIRST PROGRAM SET LOAD ORIGIN
00240 NAME1: IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00250 PUSHJ P,SIZCHK ;YES, CHECK FOR OVERLAP>
00260 CAILE H,-1(S) ;TEST FOR AVAIL. SYMBOL SPACE
00270 IFN EXPAND,< PUSHJ P,XPAND7>
00280 IFE EXPAND,< JRST SFULLC>
00290 SUBI S,2 ;UPDATE UNDEF. TABLE POINTER
00300 POP B,2(S)
00310 POP B,1(S)
00320 EXCH N,NAMPTR ;GET NAME POINTER, SAVE N
00330 HRRZ V,N ;POINTER TO PREVIOUS NAME
00340 SUBM B,V ;COMPUTE RELATIVE POSITIONS
00350 HRLM V,2(N) ;STORE FORWARD POINTER
00360 HRRZ N,B ;UPDATE NAME POINTER
00370 EXCH N,NAMPTR ;SWAP BACK
00380 NAME2: MOVEM C,1(B) ;STORE PROGRAM NAME
00390 HRRZM R,2(B) ;STORE PROGRAM ORIGIN
00400 IFN SYMDSW,<PUSH P,W ;SAVE W
00410 HRRZ W,R ;ORIGIN
00420 PUSHJ P,SYM1X ;PUT IN DSK FILE ALSO
00430 POP P,W>
00440 CAMG W,COMSAV ;CHECK COMMON SIZE
00450 IFE REENT,<JRST LIB3 ;COMMON OK>
00460 IFN REENT,<JRST [TRNE F,SEGFL ;LOAD LOW IN HI-SEG
00470 PUSHJ P,FAKEHI ;YES
00480 JRST LIB3]>
00490 SKIPA C,COMM
00500 ILC: MOVE C,1(A) ;NAME
00510 PUSH P,C ;SAVE COMMON NAME
00520 ERROR ,</ILL. COMMON !/>
00530 POP P,C
00540 PUSHJ P,PRNAME
00550 ILC1: SKIPN SBRNAM
00560 JRST ILC2
00570 ERROR 0,</ PROG. !/>
00580 MOVE C,SBRNAM ;RECOVER SUBROUTINE NAME
00590 PUSHJ P,PRNAME
00600 ILC2: ERROR 0,</ #/>
00610 JRST LD2
00620
00630 NAMERR: TLNE F,FULLSW ;IF NOT ENUF CORE
00640 JRST NAME0 ;END BLOCK IS NEVER SEEN
00650 SETZM DTIN ;CLEAR WRONG FILE NAME FOR MESSAGE
00660 ERROR ,</NO END BLOCK !/>
00670 JRST ILC1
00680
00010 ;COMPILER TYPE - DO SPECIAL FUNCTION FOR IT
00020
00030 CMPLER:
00040 JFCL ; 0 UNKNOWN
00050 PUSHJ P,F40NAM ; 1 FORTRAN (F40)
00060 TRO N,COBFL!VFLG ; 2 COBOL
00070 PUSHJ P,ALGNAM ; 3 ALGOL-60
00080 TRO N,NELFL ; 4 NELIAC
00090 TRO N,PL1FL ; 5 PL/1
00100 TRO N,BLIFL ; 6 BLISS-10
00110 TRO N,SAIFL ; 7 SAIL
00120 PUSHJ P,FORNAM ;10 FORTRAN-10
00130 ;11 MACRO
00140 ;12 FAIL
00150 CMPLEN==.-CMPLER
00160
00170
00180
00190 F40NAM: TRNE N,FORFL ;CANNOT MIX OLD & NEW
00200 JRST F40ERR
00210 TRO N,F4FL!VFLG ;SET FLAGS
00220 IFE ALGSW,<ALGNAM:;PUT LABEL ON A POPJ>
00230 POPJ P,
00240
00250 FORNAM: TRNE N,F4FL ;CANNOT MIX OLD & NEW
00260 JRST F40ERR
00270 TRO N,FORFL!VFLG
00280 IFN FORSW,<SKIPG FORLIB ;IF NOT SET FOR FOROTS
00290 AOS FORLIB ;DO SO>
00300 HLLZ V,V ;SEE IF ANY CPU BITS
00310 ROT V,6 ;PUT IN BITS 30-35
00320 CAILE V,2 ;ONLY 0, 1, 2 VALID
00330 SETZ V, ;DEFAULT
00340 PUSHJ P,@[EXP CPOPJ,FORNMA,FORNMI](V)
00350 IFN REENT,<SKIPL VSW ;USER DOES N'T WANT REENT OTS?
00360 TRNE F,NOHI!SEGFL!SEENHI ;USER SET SEGMENT OR HI CODE SEEN?
00370 POPJ P,> ;YES
00380 TRO F,NOHI ;DEFAULT IS ONE SEG
00390 TRO N,F10TFL ;BUT ONLY FOR THIS FILE
00400 IFN FORSW,<HRRZM F,FORLIB> ;SET FOROTS BY DEFAULT (FORLIB .GT. 0)
00410 POPJ P,
00420
00430 FORNMI: TRNE N,KA10FL ;CANNOT MIX KA & KI
00440 JRST FORERR
00450 TRO N,KI10FL ;SET FLAGS
00460 POPJ P,
00470
00480 FORNMA: TRNE N,KA10FL ;CANNOT MIX KA & KI
00490 JRST FORERR
00500 TLO N,KA10FL
00510 POPJ P,
00520
00530 F40ERR: ERROR ,</CANNOT MIX F40 AND FORTRAN-10 COMPILED CODE@/>
00540 FORERR: ERROR ,</CANNOT MIX KA10 AND KI10 FORTRAN-10 COMPILED CODE@/>
00550
00560 IFN ALGSW,<
00570 ALGNAM: TRO N,ALGFL!VFLG ;SET ALGOL SEEN, AND DEFAULT REENT OPSYS
00580 JUMPE W,CPOPJ ;NOT ALGOL MAIN PROGRAM
00590 IFN NAMESW,<
00600 PUSH P,C ;SAVE NAME
00610 MOVE W,C ;EXPECTS NAME IN W
00620 PUSHJ P,LDNAM ;USE THIS A PROGRAM NAME
00630 POP P,C ;RESTORE C>
00640 SETZ W, ;CLEAR COMMON SIZE, ONLY A MARKER
00650 POPJ P, ;RETURN
00660 >
00010 SUBTTL STARTING ADDRESS (BLOCK TYPE 7)
00020
00030
00040 START: PUSHJ P,PRWORD ;READ TWO DATA WORDS
00050 TLNN N,ISAFLG ;SKIP IF IGNORE SA FLAG ON
00060 HRRZM C,STADDR ;SET STARTING ADDRESS
00070 IFN NAMESW,<
00080 MOVE W,DTIN ;PICK UP BINARY FILE NAME
00090 TLNN N,ISAFLG
00100 MOVEM W,PRGNAM ;SAVE IT
00110 MOVE W,NAMPTR ;GET NAME POINTER
00120 MOVE W,1(W) ;SET UP NAME OF THIS PROGRAM
00130 IFE ALGSW,<TLNN N,ISAFLG ;DONT SET NAME IF IGNORING SA'S>
00140 IFN ALGSW,<TDNN N,[ISAFLG,,ALGFL] ;OR ALGOL LOADING>
00150 PUSHJ P,LDNAM>
00160 PUSHJ P,PRWORD ;**OBSCURE RETURN TO LOAD1**
00170
00180 IFN REENT,<
00190 RESTRX: TLNE F,HIPROG
00200 SKIPA X,HIGHX
00210 MOVE X,LOWX
00220 POPJ P,>
00010 SUBTTL ONE PASS LOCAL DEFINITION (BLOCK TYPE 10)
00020
00030 ;PMP PATCH FOR LEFT HALF FIXUPS
00040 IFN FAILSW!B11SW!WFWSW,<
00050 LOCDLH: IFN L,<CAMGE V,RINITL
00060 POPJ P,>
00070 IFN REENT,<CAMGE V,HVAL1
00080 SKIPA X,LOWX
00090 MOVE X,HIGHX>
00100 IFN MONLOD,<PUSHJ P,DICHK>
00110 HLRZ T,@X ;LOAD NEXT ADDRESS IN CHAIN
00120 HRLM W,@X ;INSERT VALUE INTO PROGRAM
00130 MOVE V,T
00140 LOCDLF: JUMPN V,LOCDLH ;JUMP IF NOT LAST ADDR. IN CHAIN
00150 POPJ P,>
00160 IFN FAILSW,<
00170 LOCDLI: PUSHJ P,LOCDLF
00180 IFN REENT,<PUSHJ P,RESTRX>
00190 AOSA LFTHSW ;TURN OFF LEFT HALF FIX SW (WAS -1) AND SKIP
00200 LOCDLG: SETOM LFTHSW ;TURN ON LEFT HALF FIX SW>
00210 ;END PMP PATCH
00220 LOCD: PUSHJ P,RWORD ;READ ONE DATA WORD
00230 HLRZ V,W ;STORAGE POINTER IN LEFT HALF
00240 IFN FAILSW,<
00250 SKIPE LFTHSW ;LEFT HALF CHAINED? PMP
00260 JRST LOCDLI ;YES PMP
00270 CAMN W,[-1] ;LEFT HALF NEXT? PMP
00280 JRST LOCDLG ;YES, SET SWITCH PMP>
00290 PUSHJ P,SYM4A ;LINK BACK REFERENCES
00300 IFN REENT,<PUSHJ P,RESTRX>
00310 JRST LOCD
00010 SUBTTL LVAR FIX-UP (BLOCK TYPE 13)
00020 IFN WFWSW,<
00030 LVARB: PUSHJ P,PRWORD ;THE FIRST TWO WORDS IN THE BLOCK
00040 MOVEM W,VARLNG ;AR SPECIAL. SECOND IS LENGTH OF VARIABLES
00050 IFN REENT,< TLNE F,HIPROG
00060 MOVE C,LOWR ;USE LOW RELOC IF LOADING HI SEG>
00070 ;ELSE C HAS RELOC FOR THIS PROGRAM, USE IT
00080 HRRZM C,VARREL ;THIS IS LOCATION 0 OF VARIABLE AREA
00090 LVLP: PUSHJ P,PRWORD ;THINGS COME IN PAIRS
00100 TLNE C,200000 ;BIT ON IF SYMBOL TABLE FIXUP
00110 JRST LVSYM
00120 HLRZ V,W ;NO GET LOC FROM LEFTH HALF OF SECOND
00130 ADD W,VARREL ;AND RELOCATE VARIABLE
00140 TLNE C,400000 ;ON FOR LEFT HALF
00150 JRST [PUSHJ P,LOCDLF ;TAKE CARE OF IT
00160 IFN REENT,< JRST LVLCOM] ;RESET X>
00170 IFE REENT,< JRST LVLP] ;MUST BE LOW SEG X OK>
00180 PUSHJ P,SYM4A ;RIGHT HALF CHAIN
00190 IFN REENT,<LVLCOM: PUSHJ P,RESTRX>
00200 JRST LVLP
00210 LVSYM: MOVE V,B ;GET SYMBOL TABLE POINTER
00220 ADD C,VARREL ;VALUE IS IN FIRST WORD FOR THESE
00230 TLZ W,740000 ;MAKE SURE NO BITS ON
00240 ADDI V,2 ;CORRECT POINTER TO SYMBOL TABLE
00250 SRSYM: MOVE A,-1(V) ;GET A NAME
00260 TLZN A,740000 ;CHECK FOR PROGRAM NAME
00270 JRST LVLP ;LEAVE (PROBABLY A NON-LOADED LOCAL)
00280 CAMN A,W ;IS IT THE RIGHT ONE??
00290 JRST LVSYMD ;YES
00300 ADD V,SE3 ;CHECK NEXT ONE
00310 JUMPL V,SRSYM ;BUT ONLY IF SOME ARE THERE
00320 JRST LVLP ;GIVE UP
00330 LVSYMD: TLNE C,400000 ;WHICH HALF??
00340 JRST LVSYML ;LEFT
00350 ADD C,(V) ;ADDITIVE FIXUP
00360 HRRM C,(V)
00370 MOVSI D,200000 ;DEFERED BITS
00380 LVSM1: PUSHJ P,COMSFX ;GO TAKE CARE OF IT
00390 JRST LVLP ;NEXT PLEASE
00400 LVSYML: HRLZS C
00410 ADDM C,(V) ;WE DON'T HAVE TO WORRY ABOUT OVERFLOW HERE
00420 MOVSI D,400000 ;LEFT DEFERED BITS
00430 JRST LVSM1 ;GO WORRY ABOUT DEFERED INTERNALS>
00010 SUBTTL FAIL LOADER
00020 ;ONLY LIST IF POLISH FIXUPS REQUIRED
00030 XLIST
00040 IFN FAILSW!B11SW,<LIST>
00050 REPEAT 0,<IF POLISH FIXUPS CONTAIN GLOBAL REQUESTS WHICH
00060 CAN NOT BE SATISFIED WHEN THEY ARE SEEN, THEY MUST BE
00070 SAVED UNTIL THESE GLOBAL SYMBOLS BECOME DEFINED.
00080 THE POLISH FIXUP IS SAVED IN THE UNDEFINED TABLE (POINTED
00090 TO BY S). THE FIXUP IS SAVED IN TWO WORD BLOCKS THE FIRST
00100 WORD OF WHICH (THE ONE WHICH WOULD NORMALL CONTAIN THE SYMBOL)
00110 HAS SPECIAL BITS ON SO IT WILL NOT BE FOUND BY A SEARCH FOR
00120 A GLOBAL REQUEST. SINCE THE UNDEFINED TABLE MAY BE
00130 SHUFFELED INTO A RANDOM ORDER, IT IS NOT POSSIBLE TO KEEP
00140 ALL OF A POLISH FIXUP TOGETHER OR TO HAVE POINTERS IN
00150 THE USUAL SENCE FROM ONE TWO WORD BLOCK TO ANOTHER.
00160 SUFFICIENT INFORMATION IS THEREFORE GIVEN TO DETERMINE
00170 WHAT THE FIRST WORD OF THE NEXT DESIRED BLOCK IS AND THIS
00180 BLOCK IS FOUND BY SEARCHING THE UNDEFINED TABLE FOR A MATCH.
00190 EACH POLISH FIXUP WHICH IS ENTERED INTO THE UNDEFINED
00200 TABLE IS GIVEN A UNIQUE NUMBER CALLED THE "HEAD NUMBER".
00210 EACH ELEMENT OF THE FIXUP (EITHER OPERAND OR OPERATOR)
00220 IS ASSIGNED A NUMBER CALLED THE "OP NUMBER". THUS
00230 THE OP NUMBER AND HEAD NUMBER TOGETHER DETERMINE
00240 A SPECIFIC ELEMENT OF A SPECIFIC FIXUP. EACH ELEMENT
00250 (TWO WORD BLOCK) IS ARRANGED AS FOLLOWS:
00260 WORD 1:
00270 BITS 0-4 THESE ARE THE USUAL CODE BITS OF A RADIX50
00280 SYMBOL AND CONTAIN 44 TO DISTINGUISH
00290 AN ELEMENT OF A POLISH FIXUP FROM OTHER
00300 SYMBOLS IN THE UNDEFINED TABLE
00310 BITS 5-17 THE HEAD NUMBER OF THIS FIXUP
00320 BITS 18-30 THE OP NUMBER OF THIS ELEMENT
00330 BITS 31-35 THE OPERAND FOR THIS ELEMENT
00340 OPERAND 2 INDICATES A WORD OF DATA
00350 WORD 2:
00360 IF THE OPERAND IS 2 THIS WORD CONTAINS THE DATA
00370
00380 IF THIS IS NOT A DATA OPERATOR THEN THE LEFT AND
00390 RIGHT HALVES OF THIS WORD POINT TO THE TWO OPERANDS
00400 THE CONTENTS OF THE HALF WORD IS THE RIGHT HALF
00410 OF THE FIRST WORD OF THE BLOCK POINTED
00420 TO. THUS THE LEFT HALF OF THE FIRST WORD COMBINED
00430 WITH ONE OF THESE HALF WORDS IS THE FIRST WORD
00440 OF THE BLOCK POINTED TO AND CAN BE FOUND BY SEARCHING
00450
00010 EACH FIXUP ALSO HAS A HEADER BLOCK. THIS BLOCK CONTAINS THE
00020 FOLLOWING INFORMATION:
00030 WORD 1:
00040 BITS 0-17 0
00050 BITS 18-21 44
00060 BITS 22-35 THE HEAD NUMBER OF THIS FIXUP
00070
00080 WORD 2:
00090 BITS 0-17 A COUNT OF THE NUMBER OF UNDEFINED
00100 GLOBALS REMAINING IN THIS FIXUP
00110 BITS 18-35 A HALF WORD POINTER OF THE
00120 SAME TYPE FOUND IN OTHER ELEMENTS POINTING
00130 TO THE FIRST ELEMENT OF POLISH
00140 WHICH WILL BE THE STORE OPERATOR
00150
00160 THE REQUESTS FOR THE GLOBAL SYMBOLS NEEDED BY THE FIXUP ARE
00170 ENTERED AS FOLLOWS:
00180
00190 WORD 1:
00200 BITS 0-4 04
00210 BITS 5-35 RADIX 50 FOR THE NAME OF THE SYMBOL
00220 (NOTE THIS IS JUST A STANDARD GLOBAL REQUEST)
00230
00240 WORD 2:
00250 BITS 0-4 44 (THIS IDENTIFIES IT AS "ADITIVE TYPE"
00260 AND BIT 4 INDICATES POLISH)
00270 BITS 5-17 THE HEAD NUMBER OF THE FIXUP
00280 (THIS GIVES ENOUGH INFORMATION TO FIND THE HEADER
00290 BLOCK AND UPDATE THE COUNT WHEN THE REQUEST IS
00300 SATISFIED)
00310 BITS 18-35 A HALF WORD POINTER TO THE ELEMENT OF THE
00320 FIXUP INTO WHICH THE VALUE OF
00330 THE SYMBOL SHOULD BE STORED
00340 >
00010 IFN FAILSW!B11SW,<
00020 ;POLISH FIXUPS <BLOCK TYPE 11>
00030
00040 PDLOV: SKIPE POLSW ;PDL OV ARE WE DOING POLISH?
00050 JRST COMPOL ;YES
00060 ERROR ,</PUSHDOWN OVERFLOW#/>
00070 JRST LD2
00080 COMPOL: ERROR ,</POLISH TOO COMPLEX#/>
00090 JRST LD2
00100
00110
00120 ;READ A HALF WORD AT A TIME
00130
00140 RDHLF: TLON N,HSW ;WHICH HALF
00150 JRST NORD
00160 PUSHJ P,RWORD ;GET A NEW ONE
00170 TLZ N,HSW ;SET TO READ OTEHR HALF
00180 MOVEM W,SVHWD ;SAVE IT
00190 HLRZS W ;GET LEFT HALF
00200 POPJ P, ;AND RETURN
00210 NORD: HRRZ W,SVHWD ;GET RIGHT HALF
00220 POPJ P, ;AND RETURN
00230
00240
00250 POLFIX: MOVE D,[IOWD PPDL,PPDB] ;SET UP THE POLISH PUSHDOWN LIST
00260 MOVEI V,100 ;IN CASE OF ON OPERATORS
00270 MOVEM V,SVSAT
00280 SETOM POLSW ;WE ARE DOING POLISH
00290 TLO N,HSW ;FIX TO READ A WORD THE FIRST TIME
00300 SETOM GLBCNT ;NUMBER OF GLOBALS IN THIS FIXUP
00310 SETOM OPNUM ;NUMBER OF OPERANDS AND OPERATORS THIS FIXUP
00320 PUSH D,[15] ;FAKE OPERATOR SO STORE WILL NOT HACK
00330
00340 RPOL: PUSHJ P,RDHLF ;GET A HLAF WORD
00350 TRNE W,400000 ;IS IT A STORE OP?
00360 JRST STOROP ;YES, DO IT
00370 IFN WFWSW,<CAIN W,15
00380 JRST [PUSHJ P,RDHLF ;THIS TRICK FOR VARIABLES
00390 ADD W,VARREL ;HOPE SOMEONE HAS DONE
00400 HRRZ C,W ;A BLOCK TYPE 13
00410 JRST HLFOP]>
00420 CAIGE W,3 ;0,1,2 ARE OPERANDS
00430 JRST OPND
00440 CAILE W,14 ;14 IS HIGHEST OPERATOR
00450 JRST LOAD4A ;ILL FORMAT
00460 PUSH D,W ;SAVE OPERATOR IN STACK
00470 MOVE V,DESTB-3(W) ;GET NUMBER OF OPERANDS NEEDED
00480 MOVEM V,SVSAT ;ALSO SAVE IT
00490 JRST RPOL ;BACK FOR MORE
00500
00010 ;HANDLE OPERANDS. THIS GETS COMPLICATED BECAUSE OF THE PRESENCE OF
00020 ;GLOBAL REQUESTS
00030
00040 OPND: MOVE A,W ;GET THE OPERAND TYPE HERE
00050 PUSHJ P,RDHLF ;THIS IS AT LEAST PART OF THE OPERAND
00060 MOVE C,W ;GET IT INTO C
00070 JUMPE A,HLFOP ;0 IS HALF-WORD OPERAND
00080 PUSHJ P,RDHLF ;NEED FULL WORD, GET SECOND HALF
00090 HRL C,W ;GET HALF IN RIGHT PLACE
00100 MOVSS C ;WELL ALMOST RIGHT
00110 SOJE A,HLFOP ;1 IS FULL WORD, 2 IS GLOBAL REQUEST
00120 PUSHJ P,SDEF ;SEE IF IT IS ALREADY DEFINED
00130 JRST [MOVE C,2(A) ;YES, WE WIN
00140 JRST HLFOP]
00150 AOSN GLBCNT ;NO, INCREMENT NUMBER OF GLOBALS THIS FIXUP
00160 AOS HEADNM ;INCREMENT FIXUP NUMBER IF FIRST GLOBAL
00170 AOS W,OPNUM ;GET AN OPERAND NUMBER
00180 LSH W,5 ;SPACE FOR TYPE
00190 IORI W,2 ;TYPE 2 IS GLOBAL
00200 HRL W,HEADNM ;GET FIXUP NUMBER
00210 PUSHJ P,SYM3X2 ;AND PUT INTO UDEFINED AREA ALONG WITH NAME
00220 MOVE C,W ;ALSO PUT THAT PART OF THE FIXUP IN
00230 PUSHJ P,SYM3X2
00240 SKIPA A,[400000] ;SET UP GLOBAL FLAG
00250 HLFOP: MOVEI A,0 ;VALUE OPERAND FLAG
00260 HLFOP1: SOJL V,CSAT ;ENOUGH OPERANDS SEEN?
00270 PUSH D,C ;NO, SAVE VALUE(OR GLOBAL NAME)
00280 HRLI A,400000 ;PUT IN A VALUE MARKER
00290 PUSH D,A ;TO THE STACK
00300 JRST RPOL ;GET MORE POLISH
00310
00010 ;HAVE ENOUGH OPERANDS FOR THE CURRENT OPERATOR
00020
00030 CSAT: HRRZS A ;KEEP ONLY THE GLOBAL-VALUE HALF
00040 SKIPN SVSAT ;IS IT UNARY
00050 JRST UNOP ;YES, NO NEED TO GET 2ND OPERAND
00060 HRL A,(D) ;GET GLOBAL VALUE MARKER FOR 2ND OP
00070 POP D,W
00080 POP D,W ;VALUE OR GLOBAL NAME
00090 UNOP: POP D,V ;OPERATOR
00100 JUMPN A,GLOB ;IF EITHER IS A GLOBAL HANDLE SPECIALLY
00110 XCT OPTAB-3(V) ;IF BOTH VALUES JUST XCT
00120 MOVE C,W ;GET THE CURRENT VALUE
00130 SETSAT: SKIPG V,(D) ;IS THERE A VALUE IN THE STACK
00140 MOVE V,-2(D) ;YES, THIS MUST BE THE OPERATOR
00150 MOVE V,DESTB-3(V) ;GET NUMBER OF OPERANDS NEEDED
00160 MOVEM V,SVSAT ;SAVE IT HERE
00170 SKIPG (D) ;WAS THERE AN OPERAND
00180 SUBI V,1 ;HAVE 1 OPERAND ALREADY
00190 JRST HLFOP1 ;GO SEE WHAT WE SHOULD DO NOW
00200
00210 ;HANDLE GLOBALS
00220 GLOB: TRNE A,-1 ;IS IT IN RIGHT HALF
00230 JRST TLHG ;NO, NEED TO PUT THIS VALUE INTO THE FIXUP LIST
00240 PUSH P,W ;SAVE FOR A WHILE
00250 MOVE W,C ;THE VALUE
00260 AOS C,OPNUM ;GET AN OPERAND NUMBER
00270 LSH C,5 ;AND PUT IN TYPE
00280 IORI C,2 ;VALUE TYPE
00290 HRL C,HEADNM ;THE FIXUP NUMBER
00300 PUSHJ P,SYM3X2
00310 POP P,W ;RETRIEVE THE OTHER VALUE
00320 TLHG: SKIPE SVSAT ;WAS THIS A UNARY OPERATOR
00330 TLNE A,-1 ;WAS THERE A GLOBAL IN LEFT HALF
00340 JRST GLSET
00350 PUSH P,C ;SAVE THE FIRST OPERAND
00360 AOS C,OPNUM ;SEE ABOVE
00370 LSH C,5
00380 IORI C,2
00390 HRL C,HEADNM
00400 PUSHJ P,SYM3X2
00410 MOVE W,C
00420 POP P,C
00430
00440 GLSET: EXCH C,W ;GET THEM IN THE OTHER ORDER
00450 HRL W,C ;SET UP THE OPERATOR LINK
00460 AOS C,OPNUM
00470 LSH C,5 ;SPACE FOR THYPE
00480 IOR C,V ;THE OPERATOR
00490 HRL C,HEADNM
00500 PUSHJ P,SYM3X2 ;INTO THE UNDEF LIST
00510 MOVEI A,400000 ;SET UP AS A GLOBAL VALUE
00520 JRST SETSAT ;AND SET UP FOR NEXT OPERATOR
00010 ;FINALLY WE GET TO STORE THIS MESS
00020
00030 STOROP: MOVE T,-2(D) ;THIS SHOULD BE THE FAKE OPERATOR
00040 CAIE T,15 ;IS IT
00050 JRST LOAD4A ;NO, ILL FORMAT
00060 HRRZ T,(D) ;GET THE VALUE TYPE
00070 JUMPN T,GLSTR ;AND TREAT GLOBALS SPECIAL
00080 MOVE A,W ;THE TYPE OF STORE OPERATOR
00090 CAIGE A,-3
00100 PUSHJ P,FSYMT
00110 PUSHJ P,RDHLF ;GET THE ADDRESS
00120 MOVE V,W ;SET UP FOR FIXUPS
00130 POP D,W ;GET THE VALUE
00140 POP D,W ;AFTER IGNORING THE FLAG
00150 PUSHJ P,@STRTAB+6(A) ;CALL THE CORRECT FIXUP ROUTINE
00160 COMSTR: SETZM POLSW ;ALL DONE WITH POLISH
00170 IFN REENT,<PUSHJ P,RESTRX>
00180 MOVE T,OPNUM ;CHECK ON SIZES
00190 MOVE V,HEADNM
00200 CAIG V,477777
00210 CAILE T,17777
00220 JRST COMPOL ;TOO BIG, GIVE ERROR
00230 PUSHJ P,RWORD ;THIS SHOULD GET US OUT (I.E RUN OUT COUNT)
00240 JRST LOAD4A ;IF NOT, SOMETHING IS WRONG
00250
00260 STRTAB: EXP ALSYM,LFSYM,RHSYM,ALSTR,LOCDLF,SYM4A,FAKESY
00270
00280 GLSTR: MOVE A,W
00290 CAIGE A,-3
00300 PUSHJ P,FSYMT
00310 PUSHJ P,RDHLF ;GET THE STORE LOCATION
00320 MOVEI A,23(A)
00330 POP D,V ;GET VALUE
00340 POP D,V
00350 HRLM V,W ;SET UP STORAGE ELEMENT
00360 AOS C,OPNUM
00370 LSH C,5
00380 IOR C,A
00390 HRL C,HEADNM
00400 PUSHJ P,SYM3X2
00410 MOVE W,C ;NOW SET UP THE HEADER
00420 AOS V,GLBCNT ;WHICH HAS NUMBER OF GLOBALS
00430 HRLM V,W
00440 HRRZ C,HEADNM
00450 PUSHJ P,SYM3X2
00460 JRST COMSTR ;AND FINISH
00470
00010 ALSTR1: IFN L,<CAMGE V,RINITL
00020 POPJ P,>
00030 IFN REENT,<CAMGE V,HVAL1
00040 SKIPA X,LOWX
00050 MOVE X,HIGHX>
00060 IFN MONLOD,<PUSHJ P,DICHK>
00070 HRRZ T,@X
00080 MOVEM W,@X ;FULL WORD FIXUPS
00090 MOVE V,T
00100 ALSTR: JUMPN V,ALSTR1
00110 POPJ P,
00120 DESTB: EXP 1,1,1,1,1,1,1,1,0,0,100
00130
00140 OPTAB: ADD W,C
00150 SUB W,C
00160 IMUL W,C
00170 IDIV W,C
00180 AND W,C
00190 IOR W,C
00200 LSH W,(C)
00210 XOR W,C
00220 SETCM W,C
00230 MOVN W,C
00240 REPEAT 7,<JRST STRSAT>
00250
00260
00270 FSYMT: PUSHJ P,RDHLF ;FIRST HALF OF SYMBOL
00280 HRL V,W
00290 PUSHJ P,RDHLF
00300 HRR V,W
00310 PUSH D,A ;SAVE STORE TYPE
00320 PUSHJ P,RDHLF ;GET BLOCK NAME
00330 HRL C,W
00340 PUSHJ P,RDHLF
00350 HRR C,W
00360 TLO C,140000 ;MAKE BLOCK NAME
00370 PUSHJ P,SDEF ;FIND IT
00380 CAMN A,B
00390 JRST FNOLOC ;MUST NOT BE LOADING LOCALS
00400 FSLP: LDB C,[POINT 32,-1(A),35] ;GET NAME
00410 CAMN C,V
00420 JRST FNDSYM
00430 SUB A,SE3
00440 CAME A,B ;ALL DONE?
00450 JRST FSLP ;NO
00460 FNOLOC: POP D,A
00470 MOVEI A,0 ;SET FOR A FAKE FIXUP
00480 AOS (P)
00490 POPJ P,
00500 FNDSYM: MOVEI W,(A) ;LOC OF SYMBOL
00510 SUB W,HISTRT
00520 POP D,A
00530 AOS (P)
00540 POPJ P,
00550
00560 LFSYM: ADD V,HISTRT
00570 HRLM W,(V)
00580 MOVSI D,400000 ;LEFT HALF
00590 JRST COMSFX
00600 RHSYM: ADD V,HISTRT
00610 HRRM W,(V)
00620 MOVSI D,200000
00630 JRST COMSFX
00640 FAKESY: POPJ P, ;IGNORE
00010 POLSAT: PUSH P,C ;SAVE SYMBOL
00020 MOVE C,V ;POINTER
00030 PUSHJ P,SREQ ;GO FIND IT
00040 SKIPA
00050 JRST LOAD4A ;SOMETHING IS ROTTEN IN DENMARK
00060 MOVEM W,2(A) ;STORE VALUE
00070 HLRZS C ;NOW FIND HEADER
00080 PUSHJ P,SREQ
00090 SKIPA
00100 JRST LOAD4A
00110 HRLZI V,-1 ;AND DECREMENT COUNT
00120 ADDB V,2(A)
00130 TLNN V,-1 ;IS IT NOW 0
00140 JRST PALSAT ;YES, GO DO POLISH
00150 POP P,C ;RESTORE SYMBOL
00160 JRST SYM2W1 ;AND RETURN
00170
00180 PALSAT: PUSH P,W ;SAVE VALUE
00190 MOVEM C,HDSAV ;SAVE THE HEADER NUMBER
00200 MOVE D,[IOWD PPDL,PPDB] ;SET UP A PDL
00210 MOVE C,V ;GET THE POINTER
00220 HRL C,HDSAV ;AND THE FIXUP NUMBER
00230 PUSHJ P,REMSYM ;REMOVE THE HEADER FORM EXISTANCE
00240 PUSHJ P,SREQ ;GO FINE THE NEXT LINK
00250 SKIPA
00260 JRST LOAD4A ;LOSE
00270 ANDI C,37 ;GET OPERATOR TYPE
00280 HRRZ V,2(A) ;PLACE TO STORE
00290 PUSH D,V
00300 PUSH D,[XWD 400000,0]
00310 PUSH D,C ;THIS HAD BETTER BE A STORE OR WE ARE IN TROUBLE
00320 HLRZ C,2(A) ;GET POINTER TO POLISH CHAIN
00330 PSAT1: PUSHJ P,REMSYM ;REMOVE SYMBOL
00340
00010 PSAT2: HRL C,HDSAV ;GET FIXUP NUMBER
00020 PUSHJ P,SREQ ;LOOK FOR IT
00030 SKIPA
00040 JRST LOAD4A
00050 ANDI C,37 ;THE OPERATOR NUMBER
00060 CAIN C,2 ;IS IT AN OPERAND?
00070 JRST PSOPD ;YES, GO PROCESS
00080 PUSH D,C ;YES STORE IT
00090 SKIPN DESTB-3(C) ;IS IT UNARY
00100 JRST PSUNOP ;YES
00110 HLRZ C,2(A) ;GET FIRST OPERAND
00120 HRLI C,600000 ;AND MARK AS VALUE
00130 PUSH D,C
00140 PSUNOP: HRRZ C,2(A) ;OTHER OPERAND
00150 JRST PSAT1 ;AND AWAY WE GO
00160
00170 PSOPD: MOVE C,2(A) ;THIS IS A VALUE
00180 PUSHJ P,REMSYM ;GET RID OF THAT PART OF THE CHAIN
00190 PSOPD1: SKIPG V,(D) ;IS THERE A VALUE IN THE STACK
00200 JRST PSOPD2 ;YES, TAKE GOOD CARE OF IT
00210 COMOP: POP D,V ;NO, GET THAT OPERATOR OUT OF THERE
00220 XCT OPTAB-3(V) ;AND DO IT
00230 MOVE C,W ;GET RESULT IN RIGHT PLACE
00240 JRST PSOPD1 ;AND TRY FOR MORE
00250 PSOPD2: TLNE V,200000 ;IS IT A POINTER
00260 JRST DBLOP ;YES, NEEDS MORE WORK
00270 MOVE W,C ;NO, ONE WE HAVE IS FIRST OPND, GET IT INTO W
00280 POP D,C ;VALUE POINTER
00290 POP D,C ;2ND OPERAND INTO C
00300 JRST COMOP ;GO PROCESS OPERATOR
00310
00320 DBLOP: EXCH C,(D) ;PUT VALUE IN STACK AND RETRIEV POINTER
00330 PUSH D,[XWD 400000,0] ;MARK AS VALUE
00340 JRST PSAT2 ;AND GO LOOK FOR MORE TROUBLE
00350
00010 IFN FAILSW,<
00020 ;BLOCK TYPE 12 LINK
00030 LINK: PUSHJ P,PRWORD ;GET TWO WORDS
00040 JUMPLE C,ENDLNK ;THIS IS AN END OF LINK WORD
00050 CAILE C,20 ;IS IT IN RANGE?
00060 JRST LOAD4A
00070 HRRZ V,W ;GET THE ADDRESS
00080 IFN REENT,<
00090 CAMGE V,HVAL1 ;CHECK HISEG ADDRESS
00100 SKIPA X,LOWX ;LOW SEGMENT
00110 MOVE X,HIGHX ;HIGH SEGMENT BASE
00120 >;IF REENT
00130 IFN MONLOD,<PUSHJ P,DICHK>
00140 HRRZ W,LINKTB(C) ;GET CURRENT LINK
00150 IFN L,< CAML V,RINITL ;LOSE>
00160 HRRM W,@X ;PUT INTO CORE
00170 HRRM V,LINKTB(C) ;SAVE LINK FOR NEXT ONE
00180 IFN REENT,<
00190 PUSHJ P,RESTRX ;RESTORE X
00200 >;IF REENT
00210 JRST LINK ;GO BACK FOR MORE
00220 ENDLNK: MOVNS C ;GET ENTRY NUMBER
00230 JUMPE C,LOAD4A ;0 IS A LOSER
00240 CAILE C,20 ;CHECK RANGE
00250 JRST LOAD4A
00260 HRLM W,LINKTB(C) ;SAVE END OF LINK INFO
00270 JRST LINK ;MORE
00280
00290 > ;END OF IFN FAILSW
00010 STRSAT: MOVE W,C ;GET VALUE TO STORE IN W
00020 MOVE C,V ;GET OPERATOR HERE
00030 POP D,V
00040 POP D,V ;GET ADDRESS TO STORE
00050 PUSHJ P,@STRTAB-15(C)
00060 IFN REENT,<PUSHJ P,RESTRX>
00070 POP P,W ;RESTORE THINGS
00080 POP P,C
00090 JRST SYM2W1
00100
00110 ALSYM: ADD V,HISTRT
00120 MOVEM W,(V)
00130 MOVSI D,600000
00140 >
00150 LIST ;END OF FAILSW CODE
00160 IFN FAILSW!B11SW!WFWSW,<
00170 COMSFX: IFN REENT,<PUSHJ P,SYMFX1
00180 JRST RESTRX>
00190 IFE REENT,<JRST SYMFX1>>
00200
00010 SUBTTL LIBRARY INDEX (BLOCK TYPE 14)
00020
00030 COMMENT * DIRECT ACCESS LIBRARY SEARCH MODE
00040 INDEX WRITTEN BY FUDGE2.SEE DIDAL DOC (100-540-001-00)
00050 DESIGN AND CODING BY D.M.NIXON JUL-AUG 1970
00060 *
00070
00080 IFN DIDAL,<
00090
00100 INDEX8: POP P,LSTBLK ;SET UP LSTBLK FOR NEXT PROG
00110 PUSHJ P,WORD ;READ FIRST WORD
00120 HLRZ A,W ;BLOCK TYPE ONLY
00130 CAIE A,14 ;IS IT AN INDEX?
00140 JRST INDEXE ;NO, ERROR
00150 JRST INDEX9 ;DON'T SET FLAG AGAIN
00160
00170 INDEX0: TRO F,XFLG ;SIGNAL INDEX IN CORE
00180 MOVEI A,1 ;START ON BLOCK 1 (DSK)
00190 HRROM A,LSTBLK ;BUT INDICATE AN INDEX
00200 MOVE A,ILD1 ;INPUT DEVICE
00210 DEVCHR A,
00220 TLNE A,DTABIT ;IS IT A DTA?
00230 TRO F,DTAFLG ;YES
00240 INDEX9: MOVEI A,AUX+2 ;AUX BUFFER
00250 HRLI A,4400 ;MAKE BYTE POINTER
00260 MOVEM A,ABUF1 ;AND SAVE IT
00270 HRL A,BUFR1 ;INPUT BUFFER
00280 BLT A,AUX+201 ;STORE BLOCK
00290 TRO F,LSTLOD ;AND FAKE LAST PROG READ
00300 INDEX1: ILDB T,ABUF1
00310 JUMPL T,INDEX3 ;END OF BLOCK IF NEGATIVE
00320 HRRZS T ;WORD COUNT ONLY
00330 INDEX2: ILDB C,ABUF1 ;GET NEXT SYMBOL
00340 TLO C,040000 ;
00350 PUSHJ P,SREQ ;SEARCH FOR IT
00360 SOJA T,INDEX4 ;REQUEST MATCHES
00370 SOJG T,INDEX2 ;KEEP TRYING
00380 ILDB T,ABUF1 ;GET POINTER WORD
00390 TRZN F,LSTLOD ;WAS LAST PROG LOADED?
00400 JRST INDEX1 ;NO
00410 TRNN F,DTAFLG ;ALWAYS SAVE IF DTA???
00420 SKIPL LSTBLK ;SKIP IF LAST BLOCK WAS AN INDEX
00430 MOVEM T,LSTBLK ;SAVE POINTER FOR CALCULATIONS
00440 JRST INDEX1 ;GET NEXT PROG
00010 INDEX4: ADDM T,ABUF1
00020 ILDB A,ABUF1
00030 PUSH P,A ;SAVE THIS BLOCK
00040 TROE F,LSTLOD ;DID WE LOAD LAST PROG?
00050 JRST [SKIPGE LSTBLK ;WAS LAST BLOCK AN INDEX?
00060 JRST NXTBLK ;YES, SO GET NEXT ONE
00070 MOVEM A,LSTBLK
00080 JRST LOAD1] ;NEXT PROG IS ADJACENT
00090 HRRZ T,LSTBLK ;GET LAST BLOCK NUMBER
00100 CAIN T,(A) ;IN THIS BLOCK?
00110 JRST THSBLK ;YES
00120 NXTNDX: TRNE F,DTAFLG ;DIFFERENT TEST FOR DTA
00130 JRST NXTDTA ;CHECK IF NEXT BUFFER IN CORE
00140 CAIN T,-1(A) ;NEXT BLOCK?
00150 JRST NXTBLK ;YES,JUST DO INPUT
00160 INDEX5: USETI 1,(A) ;SET ON BLOCK
00170 WAIT 1, ;LET I/O FINISH
00180 MOVSI C,(1B0) ;CLEAR RING USE BIT IF ON
00190 HRRZ T,BUFR
00200 IORM C,BUFR ;SET UNUSED RING BIT (HELP OUT MONITOR)
00210 SKIPL (T)
00220 JRST NXTBLK ;ALL DONE NOW
00230 ANDCAM C,(T) ;CLEAR USE BIT
00240 HRRZ T,(T) ;GET NEXT BUFFER
00250 JRST .-4 ;LOOP
00260
00270 NXTDTA: WAIT 1, ;LET I/O RUN TO COMPLETION
00280 HRRZ T,BUFR ;GET POINTER TO CURRENT BUFFER
00290 HLRZ T,1(T) ;FIRST DATA WORD IS LINK
00300 CAIE T,(A) ;IS IT BLOCK WE WANT?
00310 JRST INDEX5 ;NO
00320 NXTBLK: IN 1,
00330 JRST NEWBLK ;IT IS NOW
00340 JRST WORD3 ;EOF OR ERROR
00350
00360 NEWBLK: MOVE A,(P) ;GET CURRENT BLOCK
00370 JUMPL A,INDEX8 ;JUST READ AN INDEX
00380 HLRZS A ;GET WORD COUNT
00390 JRST INDEX6 ;WORD COUNT WILL BE CORRECT
00400
00010 THSBLK: SUB A,LSTBLK ;GET WORD DIFFERENCE
00020 MOVSS A ;INTO RIGHT HALF
00030 INDEX6: ADDM A,BUFR1
00040 MOVNS A
00050 ADDM A,BUFR2
00060 INDEX7: POP P,LSTBLK ;STORE THIS AS LAST BLOCK READ
00070 JRST LOAD1
00080
00090 INDEX3: HRRE A,T ;GET BLOCK # OF NEXT INDEX
00100 JUMPL A,EOF ;FINISHED IF -1
00110 PUSH P,T ;STACK THIS BLOCK
00120 HRRZ T,LSTBLK ;GET LAST BLOCK
00130 JRST NXTNDX ;CHECK IF NEXT BUFFER IN CORE
00140
00150 INDEX: PUSHJ P,WORD2 ;READ FIRST WORD OF NEXT BUFFER
00160 INDEXE: TRZE F,XFLG ;INDEX IN CORE?
00170 TTCALL 3,[ASCIZ /LIBRARY INDEX INCONSISTENT - CONTINUING
00180 /] ;WARNING MESSAGE
00190 JRST LOAD1A+1 ;AND CONTINUE
00200 >
00210
00220 IFE DIDAL,<INDEX0:
00230 INDEX: PUSHJ P,WORD2 ;READ FIRST WORD OF NEXT BUFFER
00240 JRST LOAD1A+1>
00250
00010 SUBTTL ALGOL OWN BLOCK (TYPE 15)
00020
00030 IFN ALGSW,<
00040 ALGBLK: SKIPE OWNLNG ;FIRST TIME THIS PROG?
00050 JRST ALGB1 ;NO, JUST CHAINED SYMBOL INFO
00060 PUSHJ P,RWORD ;READ 3RD WORD
00070 IFN REENT,<TLNE F,HIPROG ;LOADING INTO HIGH SEGMENT?
00080 EXCH X,LOWX ;YES, BUT OWN AREAS ARE IN LOW SEG>
00090 HLRZ V,W ;GET START OF OWN BLOCK
00100 IFN REENT,<TLNE F,HIPROG ;LOADING INTO HIGH SEGMENT?
00110 HRRZ V,LOWR ;YES, BUT PUT OWN AREAS IN LOW SEG>
00120 MOVEI C,(W) ;GET LENGTH OF OWN BLOCK
00130 MOVEM C,OWNLNG ;SAVE IT TO FIX RELOC AT END
00140 PUSHJ P,ALGB2 ;FIX AND CHECK PROG BREAK
00150 MOVEI W,(V) ;GET CURRENT OWN ADDRESS
00160 EXCH W,%OWN ;SAVE FOR NEXT TIME
00170 MOVEM W,@X ;STORE LAST OWN ADDRESS IN LEFT HALF
00180 HRLM C,@X ;LENGTH IN LEFT HALF
00190 IFN REENT,<TLNE F,HIPROG ;HI-SEG?
00200 EXCH X,LOWX ;YES, RESTORE X TO POINT TO HIGH SEG>
00210 ALGB1: PUSHJ P,RWORD ;GET DATA WORD
00220 HLRZ V,W ;GET ADDRESS TO FIX UP
00230 ADD W,%OWN ;ADD IN ADDRESS OF OWN BLOCK
00240 PUSHJ P,SYM4A ;FIX UP CHAINED REQUEST
00250 JRST ALGB1 ;LOOP TIL DONE
00260
00270 ALGB2: ADDI H,(W) ;FIX PROG BREAK
00280 IFN REENT,<CAML H,HILOW
00290 MOVEM H,HILOW ;HIGHEST LOW CODE LOADED>
00300 CAILE H,1(S) ;SKIP IF SUFFICIENT CORE AVAILABLE
00310 IFN EXPAND,<JRST [PUSHJ P,XPAND>
00320 JRST FULLC
00330 IFN EXPAND,< JRST .+1]>
00340 POPJ P,
00350
00360
00370 >
00010 SUBTTL SAIL BLOCK TYPES 16 AND 17
00020
00030 COMMENT * BLOCK TYPE 16 AND 17. SIXBIT FOR FIL,PPN,DEV
00040 IN THE BLOCK. SEARCH TABLE FOR ALREADY REQUESTED. IF NOT
00050 ENTER REQUEST. ORIGINAL CODE BY DCS REWRITTEN BY WFW*
00060
00070 IFN SAILSW,<
00080 LDPRG: MOVEI D,PRGFLS-1 ;SET UP SOMETHING WE CAN SEARCH WITH
00090 MOVE W,PRGPNT ;AND CURRENT POINTER
00100 PUSHJ P,LDSAV ;GO ENTER (WILL NOT RETURN IF RUNS OUT)
00110 MOVEM D,PRGPNT
00120 JRST LDPRG ;BACK FOR MORE
00130 LDLIB: MOVEI D,LIBFLS-1
00140 MOVE W,LIBPNT
00150 PUSHJ P,LDSAV
00160 MOVEM D,LIBPNT
00170 JRST LDLIB ;LOOKS JUST LIKE THE LAST ONE, DOESN'T IT
00180
00190 LDSAV: HRLI D,-RELLEN-1 ;GET AOBJN SET UP
00200 MOVEM W,LODPN2# ;SAV IT
00210 PUSHJ P,PRWORD ;GET FILE,PPN
00220 MOVE A,W ;SAVE ONE
00230 PUSHJ P,RWORD ;AND DEVICE
00240 FILSR: CAMN D,LODPN2
00250 JRST FENT ;HAVE GOTTEN THERE, ENTER FILE
00260 CAME C,PRGFIL(D) ;CHECK FOR MATCH
00270 JRST NOMT ;NOT FILE
00280 CAME A,PRGPPN(D)
00290 JRST NOMT ;NO PPN
00300 CAME W,PRGDEV(D)
00310 NOMT: AOBJN D,FILSR ;AND NOT DEVICE SHOULD ALWAYS JUMP
00320 MOVE D,LODPN2
00330 POPJ P, ;JUST RETURN CURRENT POINTER
00340 FENT: MOVE D,LODPN2 ;ENTER IT
00350 AOBJP D,WRONG ;THAT IS IF NOT TOO MANY
00360 MOVEM C,PRGFIL-1(D) ;HAVE ALREADY INDEXED
00370 MOVEM A,PRGPPN-1(D) ;HENCE THE -1
00380 MOVEM W,PRGDEV-1(D)
00390 POPJ P,
00400 WRONG: ERROR ,</TOO MANY DEMANDED FILES#/>
00410 JRST LD2
00420 >
00010 SUBTTL COMMON ALLOCATION (BLOCK TYPE 20)
00020
00030 COMMENT * THIS BLOCK CONSISTS OF WORD PAIRS (SAME AS TYPE 2)
00040 FIRST WORD IS RADIX50 04,SYMBOL
00050 SECOND WORD IS 0,,COMMON LENGTH
00060 COMMON NAME MUST BE GLOBAL AND UNIQUE
00070 IF NOT ALREADY DEFINED LOADER DEFINES SYMBOL AND ALLOCATES
00080 SPACE. IF DEFINED LOADER CHECK FOR TRYING TO INCREASE COMMON
00090 SIZE, AND GIVES ERROR IF SO
00100 NOTE... COMMON BLOCKS MUST COME DEFORE ANY DATA BLOCKS
00110 IE. AFTER BLOCKS 4,6,3 BUT BEFORE 1,2,37,..5
00120 *
00130
00140 IFN K,<COMML==LOAD4A>
00150 IFE K,<
00160 COMML: PUSHJ P,PRWORD ;GET WORD PAIR
00170 TLO C,400000 ;TURN IT INTO 44,SYMBOL (FOR FORTRAN)
00180 TLO N,F4SW ;INHIBITS MATCH WITH 04,SYMBOL
00190 PUSHJ P,SDEF ;SEE IF ALREADY DEFINED
00200 JRST COMMLD ;YES, JUST CHECK SIZE
00210 TLZ N,F4SW ;CLEAR AGAIN
00220 IFN REENT,<TLNN F,HIPROG ;LOADING INTO HIGH SEGMENT?
00230 JRST .+3 ;NO
00240 EXCH R,LOWR ;YES, BUT COMMON ALWAYS GOES TO LOW SEG
00250 EXCH X,LOWX>
00260 HRL W,R ;CURRENT RELOCATION
00270 ADDI R,(W) ;BUMP RELOCATION
00280 MOVS W,W ;LENGTH,,START
00290 PUSH P,W ;STORE COMMON VALUE
00300 HRRZS W ;NORMAL SYMBOL ADDRESS
00310 TLZ C,400000 ;BACK TO 04,SYMBOL
00320 PUSHJ P,SYM1B ;DEFINE IT
00330 POP P,W ;RESTORE VALUE
00340 TLO C,400000 ;AND COMMON SYMBOL
00350 PUSHJ P,SYM1B ;AND STORE IT ALSO
00360 IFN REENT,<TLNN F,HIPROG ;LOADING INTO HIGH SEGMENT?
00370 JRST COMML ;NO
00380 EXCH R,LOWR ;YES, RESTORE RELOCATION TO HIGH
00390 EXCH X,LOWX>
00400 JRST COMML ;GET NEXT SYMBOL
00410
00420 COMMLD: TLZ N,F4SW ;CLEAR AGAIN
00430 HLRZ C,2(A) ;PICK UP DEFINITION
00440 CAMLE W,C ;CHECK SIZE
00450 JRST ILC ;ILLEGAL
00460 JRST COMML ;TRY NEXT
00470 >
00010 SUBTTL SPARSE DATA (BLOCK TYPE 21)
00020
00030 COMMENT *
00040 THIS BLOCK IS SIMILAR TO TYPE 1 DATA
00050 THE DATA WORDS ARE
00060 COUNT,,LOCATION
00070 DATA WORDS (COUNT NUMBER OF TIMES)
00080 COUNT,,LOCATION
00090 DATA WORDS
00100 ETC.
00110
00120 *
00130
00140 SPDATA: PUSHJ P,RWORD ;READ BLOCK ORIGIN
00150 SKIPGE W
00160 PUSHJ P,PROGS ;SYMBOLIC IF 36 BITS
00170 HLRZ C,W ;GET SUB BLOCK COUNT IN C
00180 HRRZS W ;CLEAR IT
00190 HRRZ V,C ;AND IN V (LENGTH WE NEED)
00200 SPDTO: ADD V,W ;COMPUTE NEW PROG. BREAK
00210 IFN REENT,<TLNN F,HIPROG
00220 JRST SPDTLW ;NOT HIGH SEGMENT
00230 SPDT3: CAMGE W,HVAL1 ;CHECK TO SEE IF IN TOP SEG
00240 JRST LOWSPD
00250 MOVE T,.JBREL ;CHECK FOR OVERFLOW ON HIGH
00260 CAIL T,@X
00270 JRST SPDT2
00280 PUSHJ P,HIEXP
00290 JRST FULLC
00300 JRST SPDT3>
00310
00320 IFN MONLOD,<TLNN N,DISW ;LOADING TO DISK?
00330 JRST SPDTLW ;NO, GO CHECK NEW BREAK
00340 CAMG H,V ;NEW BREAK?
00350 MOVE H,V ;YES, UPDATE
00360 JRST SPDT2 ;NO NEED TO CHECK FOR ROOM>
00370 IFN REENT,<
00380 LOWSPD: SUB V,HIGHX ;RELOC FOR PROPER
00390 ADD V,LOWX ;LOADING OF LOW SEQMENT
00400 SUB W,HIGHX
00410 ADD W,LOWX
00420 >
00430 SPDTLW: MOVEI T,@X
00440 CAMG H,T ;COMPARE WITH PREV. PROG. BREAK
00450 MOVE H,T
00460 TLNE F,FULLSW
00470 JRST FULLC ;NO ERROR MESSAGE
00480 IFN REENT,<CAML H,HVAL1
00490 JRST COROVL ;WE HAVE OVERFLOWED THE LOW SEGMENT
00500 CAMLE T,HILOW
00510 MOVEM T,HILOW ;HIGHEST LOW CODE LOADED INTO>
00520 CAILE H,1(S) ; SKIP IF SUFFICIENT CORE AVAILABLE
00530 IFN EXPAND,<JRST [PUSHJ P,XPAND>
00540 JRST FULLC
00550 IFN REENT,< TLNE F,HIPROG
00560 SUBI W,2000 ;HISEG LOADING LOW SEG>
00570 IFN EXPAND,< JRST .-1]>
00580 SPDT2: MOVE V,W
00590 SPDT1: PUSHJ P,RWORD ;READ DATA WORD
00600 IFN L,<CAML V,RINITL ;CHECK FOR BAD STORE>
00610 IFN MONLOD,<PUSHJ P,DICHK ;MAKE SURE ADDRESS IS IN CORE>
00620 MOVEM W,@X ;STORE DATA WORD IN PROG. AT LLC
00630 IFN MONLOD,<TLO N,WOSW ;SET SWITCH TO WRITE OUT BUFFER>
00640 SOJLE C,SPDATA ;SUB-BLOCK RUN OUT, REFILL IT
00650 AOJA V,SPDT1 ;ADD ONE TO LOADER LOC. COUNTER
00660
00010 SUBTTL TENEX ASSIGNMENT (BLOCK TYPE 100)
00020
00030 IFN TENEX,<
00040 ;IMPLEMENT THE SPECIAL BLOCK 100 REQUEST FOR ASSIGNING
00050 ; AND INCREMENTING OF EXTERNALS
00060
00070 ASGSYM: PUSHJ P,RWORD ;GET FIRST WORD
00080 MOVE V,W ;SAVE SYM2
00090 PUSHJ P,PRWORD ;GET SECOND AND THIRD WORDS
00100 TLO C,040000 ;MAKE INTO GLOBAL
00110 PUSHJ P,SDEF ;SEE IF DEFINED
00120 JRST ASGSY1 ;OK. IT IS
00130 PUSH P,PRQ ;IT'S NOT, GENERATE ERROR COMMENT
00140 PUSHJ P,PRNAME
00150 JSP A,ERRPT7
00160 SIXBIT /UNDEFINED ASSIGN IN #/
00170
00180 ASGSY0: PUSHJ P,RWORD ;SHOULD RETURN TO LOAD1
00190 JRST ASGSY0 ;LOOP UNTIL IT DOES
00200
00210 ASGSY1: ADD W,2(A) ;INCREMENT VALUE
00220 EXCH W,2(A) ;SAVE NEW, GET OLD
00230 MOVE C,V ;GET SYM2
00240 TLO C,040000 ;MAKE INTO GLOBAL
00250 PUSHJ P,SYMPTQ ;AND CONTINUE AS FOR GLOBAL DEF
00260 JRST ASGSY0 ;AND RETURN
00270 >
00010 SUBTTL SYMBOL TABLE SEARCH SUBROUTINES
00020
00030 ; ENTERED WITH SYMBOL IN C
00040 ; RETURN IS WITH POINTER IN A IF MATCHING SYMBOL FOUND
00050 ; OTHERWISE, A SKIP ON RETURN OCCURS
00060
00070 SREQ: JUMPGE S,CPOPJ1 ;JUMP IF NO UNDEF. SYMBOLS
00080 SKIPA A,S ;LOAD REQUEST SEARCH POINTER
00090 SDEF: MOVE A,B ;LOAD DEF. SYMBOL SEARCH POINTER
00100 SDEF1: CAMN C,1(A)
00110 POPJ P, ;SYMBOLS MATCH, RETURN
00120 IFE K,< TLNE N,F4SW ;ARE WE IN FORTRAN?
00130 JRST SDEF2 ;YES,JUST TRY NEXT SYMBOL>
00140 TLC C,400000 ;MIGHT BE SUPPRESSED INTERNAL
00150 CAMN C,1(A) ;WAS IT?
00160 JRST [TLC C,400000 ;BACK AS IT WAS
00170 IORM C,1(A) ;YES, SO ENSURE IT'S SUPPRESSED
00180 POPJ P,] ;EXIT WITH SYMBOL FOUND
00190 TLC C,400000 ;NO, TRY NEXT SYMBOL
00200 SDEF2: ADD A,SE3
00210 JUMPL A,SDEF1
00220 IFE K,< JRST CPOPJ1 ;SYMBOL NOT FOUND SKIPS ON RETURN>
00230 IFN K,<
00240 CPOPJ1: AOS (P)
00250 POPJ P,>
00260
00010 SUBTTL RELOCATION AND BLOCK INPUT
00020
00030 PRWORD: PUSHJ P,RWORD ;READ A WORD PAIR
00040 MOVE C,W ;LOAD C WITH FIRST DATA WORD
00050 TRNE E,377777 ;TEST FOR END OF BLOCK
00060 JRST RWORD1 ;INPUT SECOND WORD OF PAIR
00070 MOVEI W,0 ;NO SECOND WORD, ASSUME ZERO
00080 POPJ P,
00090
00100 RWORD: TRNN E,377777 ;TEST FOR END OF BLOCK
00110 JRST LOAD1 ;RETURN TO LOAD THE NEXT BLOCK
00120 RWORD1: AOBJN E,RWORD2 ;JUMP IF DATA WORD NEXT
00130 PUSHJ P,WORD ;READ CONTROL WORD
00140 MOVE Q,W ;DON'T COUNT RELOCATION WORDS
00150 HRLI E,-22 ;SET RELOCATION WORD BYTE COUNT
00160 RWORD2: PUSHJ P,WORD ;READ INPUT WORD
00170 JUMPGE Q,RWORD3 ;TEST LH RELOCATION BIT
00180 TRNN F,TWOFL ;POSSIBLE TWO SEGMENTS?
00190 JRST RWORD5 ;NO
00200 MOVSS W
00210 PUSHJ P,CHECK ;USE CORRECT RELOCATION
00220 HRRI W,@R
00230 MOVSS W
00240 JRST RWORD3 ;AND TEST RIGHT HALF
00250 RWORD5: HRLZ T,R
00260 ADD W,T ;LH RELOCATION
00270 RWORD3: TLNN Q,200000 ;TEST RH RELOCATION BIT
00280 JRST RWORD4 ;NOT RELOCATABLE
00290 TRNE F,TWOFL ;POSSIBLE TWO SEGMENTS?
00300 PUSHJ P,CHECK ;USE CORRECT RELOCATION
00310 HRRI W,@R ;RH RELOCATION
00320 RWORD4: LSH Q,2
00330 POPJ P,
00340
00350 CHECK: MOVE T,HVAL1 ;START OF HISEGMENT
00360 CAIG T,NEGOFF(W) ;IN HISEG?
00370 JRST [CAILE W,(W) ;IS ADDRESS BELOW HISEG START?
00380 JRST [MOVNS T ;YES
00390 ADDI T,(W) ;THEREFORE WORRY ABOUT CARRY
00400 HRR W,T ;INTO LEFT HALF
00410 POPJ P,]
00420 SUBI W,(T) ;IN HISEG, REMOVE OFSET
00430 POPJ P,]
00440 HRRI W,@LOWR ;USE LOW SEG RELOC
00450 JRST CPOPJ1 ;SKIP RETURN
00010 SUBTTL PRINT STORAGE MAP SUBROUTINE
00020
00030 PRMAP: TRZ F,LOCAFL ;ASSUME LOCAL SYMBOLS SUPPRESSED
00040 CAIE D,1 ;IF /1M PRINT LOCAL SYMBOLS
00050 CAMN D,[-7] ;TEST FOR /-1M ALSO
00060 TRO F,LOCAFL ;YES,TURN ON FLAG
00070 JUMPL D,PRTMAP-1 ;JUMP IF /-M OR /-1M
00080 TRO N,ENDMAP ;ELSE SET DEFERRED MAP FLAG
00090 POPJ P,
00100
00110 TRZ N,ENDMAP ;CLEAR DELAYED MAP FLAG
00120 PRTMAP: PUSHJ P,FSCN1 ;LOAD OTHER FILES FIRST
00130 IFN SPCHN,<TRZ N,MAPSUP ;SET MAP NOT SUPPRESSED
00140 SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
00150 TRNN N,CHNMAP ;TEST FOR ROOT MAP ALREADY PRINTED
00160 JRST PRMP0A ; SKIP IF NO TO EITHER QUESTION
00170 PUSHJ P,CRLFLF ;SPACE TWO LINE AND FORCE TTY OUTPUT
00180 TLZ F,FCONSW ;SUPPRESS TTY OUTPUT
00190 ERROR 0,</******************** !/> ;PRINT SEPARATOR
00200 TLO F,FCONSW ;FORCE TTY OUTPUT AGAIN
00210 ERROR 0,</LINK !/> ;PRINT LINK NUMBER
00220 MOVE W,LINKNR ;GET CURRENT LINK NUMBER
00230 PUSHJ P,RCNUMW ;PRINT IT IN DECIMAL
00240 TLZ F,FCONSW ;SUPPRESS TTY OUTPUT
00250 ERROR 0,</ ********************!/> ;PRINT SEPARATOR
00260 PUSHJ P,CRLF ;PUT BLANK LINE ON MAP FILE ONLY
00270 PUSHJ P,CRLF ; DITTO
00280 TLO F,FCONSW ;FORCE TTY OUTPUT AGAIN
00290 PUSHJ P,CRLF
00300 JRST .+2 ;SKIP NEXT CRLF CALL
00310 PRMP0A: >
00320 PUSHJ P,CRLFLF ;START NEW PAGE
00330 HRRZ W,R
00340 IFN REENT,<CAIG W,.JBDA ;LOADED INTO LOW SEGMENT
00350 JRST NOLOW ;DON'T PRINT IF NOTHING THERE>
00360 PUSHJ P,PRNUM0
00370 IFE REENT,<ERROR 7,<?IS THE PROGRAM BREAK@?>>
00380 IFN REENT,<ERROR 7,<?IS THE LOW SEGMENT BREAK@?>
00390 PUSHJ P,CRLF ;CR-LF ON ALL BUT TTY
00400 NOLOW: MOVE W,HVAL ;HISEG BREAK
00410 CAMG W,HVAL1 ;HAS IT CHANGED
00420 JRST NOHIGH ;NO HI-SEGMENT
00430 TLO F,FCONSW ;FORCE OUT HI-SEG BREAK ALSO
00440 PUSHJ P,PRNUM0
00450 ERROR 7,<?IS THE HIGH SEGMENT BREAK@?>
00460 PUSHJ P,CRLF
00470 NOHIGH:>
00480 IFN SPCHN,<SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
00490 TRNN N,CHNMAP ;TEST FOR ROOT MAP ALREADY PRINTED
00500 JRST .+2 ; NO TO EITHER QUESTION, FALL THRU
00510 JRST NOADDR ; ELSE SKIP HEADING OUTPUT>
00520 IFE NAMESW,< MOVE W,DTOUT ;OUTPUT NAME >
00530 IFN NAMESW,< SKIPN W,DTOUT
00540 MOVE W,CURNAM ;USE PROGRAM NAME>
00550 JUMPE W,.+3 ;DON'T PRINT IF NOT THERE
00560 PUSHJ P,PWORD
00570 PUSHJ P,SPACES ;SOME SPACES
00580
00010 ;HERE TO DECODE AND PRINT VERSION NUMBER IN .JBVER
00020 ;USES T,V,D,Q
00030 IFN MONLOD,<TLNE N,DISW ;LOADING TO DISK?
00040 MOVE X,XRES ;YES, SETUP X >
00050 IFE L,<
00060 SKIPN V,.JBVER(X) ;GET VERSION NUMBER
00070 JRST NOVER ;WASN'T ONE
00080 ROT V,3 ;PUT USER BITS LAST
00090 MOVEI T,"%" ;TO INDICATE VERSION
00100 PUSHJ P,TYPE2 ;OUTPUT CHARACTER
00110 MOVEI Q,3 ;3 BYTES IN MAJOR FIELD
00120 PUSHJ P,SHFTL ;SHIFT LEFT, SKIP 0 BYTES
00130 JRST .+3 ;NO MAJOR FIELD
00140 MOVEI D,"0" ;CONVERT TO ASCII 0-8
00150 PUSHJ P,OUTVER ;OUTPUT IT
00160 MOVEI Q,2 ;2 DIGITS IN MINOR FIELD
00170 PUSHJ P,SHFTL
00180 JRST .+3 ;NO MINOR FIELD
00190 MOVEI D,"@" ;ALPHABETICAL
00200 PUSHJ P,OUTVER
00210 MOVEI T,"(" ;EDIT NUMBER IN PARENS
00220 TLNN V,-1 ;SEE IF GIVEN
00230 JRST NOEDIT ;NO
00240 PUSHJ P,TYPE2 ;YES
00250 MOVEI Q,6
00260 PUSHJ P,SHFTL ;LEFT JUSTIFY
00270 JRST .+3 ;NEVER GETS HERE
00280 MOVEI D,"0" ;0-7 AGAIN
00290 PUSHJ P,OUTVER
00300 MOVEI T,")" ;CLOSE VERSION
00310 PUSHJ P,TYPE2
00320 NOEDIT: MOVEI T,"-" ;USER FIELD?
00330 JUMPE V,.+4 ;NO
00340 PUSHJ P,TYPE2 ;YES
00350 MOVEI Q,1 ;ONLY ONE DIGIT
00360 PUSHJ P,OUTVER ;OUTPUT IT
00370 PUSHJ P,SPACES ;SOME SPACES
00380 NOVER:>;END OF IFE L
00010 ERROR 0,<?STORAGE MAP!?>
00020 PUSHJ P,SPACES ;SOME SPACES
00030 PUSH P,N
00040 PUSH P,E
00050 MOVE N,[POINT 6,DBUF] ;INITIALIZE DATE POINTER
00060 MSTIME Q, ;GET THE TIME
00070 IDIVI Q,↑D60*↑D1000
00080 IDIVI Q,↑D60
00090 PUSH P,A ;SAVE MINUTES
00100 PUSHJ P,OTOD1 ;STORE HOURS
00110 POP P,Q ;GET MINUTES
00120 PUSHJ P,OTOD ;STORE MINUTES
00130 DATE E, ;GET DATE
00140 IDIVI E,↑D31 ;GET DAY
00150 ADDI Q,1
00160 PUSHJ P,OTOD ;STORE DAY
00170 IDIVI E,↑D12 ;GET MONTH
00180 ROT Q,-1 ;DIV BY 2
00190 HRR A,DTAB(Q) ;GET MNEMONIC
00200 TLNN Q,400000
00210 HLR A,DTAB(Q) ;OTHER SIDE
00220 HRRM A,DBUF+1 ;STORE IT
00230 MOVEI Q,↑D64(E) ;GET YEAR
00240 MOVE N,[POINT 6,DBUF+2]
00250 PUSHJ P,OTOD ;STORE IT
00260 POP P,E
00270 POP P,N
00280 PUSHJ P,DBUF1
00290 PUSHJ P,CRLF
00300 SKIPN STADDR ;PRINT STARTING ADDRESS
00310 JRST NOADDR ;NO ADDRESS SEEN
00320 ERROR 0,</STARTING ADDRESS !/>
00330 PUSHJ P,SP1
00340 MOVE W,STADDR ;GET ST. ADDR.
00350 PUSHJ P,PRNUM0 ;PRINT IT
00360 IFN NAMESW,<
00370 PUSHJ P,SP1
00380 MOVE W,[SIXBIT / PROG /]
00390 PUSHJ P,PWORD
00400 MOVE W,CURNAM ;PROG NAME
00410 PUSHJ P,PWORD
00420 PUSHJ P,SP1
00430 MOVE W,ERRPT6 ;SIXBIT / FILE /
00440 PUSHJ P,PWORD
00450 MOVE W,PRGNAM ;FILE NAME
00460 PUSHJ P,PWORD>
00470 NOADDR: IFN REENT,<
00480 HRRZ A,HVAL1 ;GET INITIAL HIGH START
00490 ADDI A,.JBHDA ;ADD IN OFFSET
00500 IFN SPCHN,<HRL A,BEGOV ;ASSUME NON-ROOT OVERLAY
00510 SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
00520 TRNN N,CHNMAP ;TEST FOR ROOT-MAP PRINTED
00530 ;ASSUMPTION CORRECT IF YES TO BOTH
00540 ; SKIP NEXT INSTRUCTION IF SO >
00550 HRLI A,.JBDA ;LOW START
00560 MOVSM A,SVBRKS ;INITIAL BREAKS>
00570 HLRE A,B
00580 MOVNS A
00590 ADDI A,(B)
00600 PRMAP1: SUBI A,2
00610 IFN REENT!L,<SKIPN C,1(A) ;LOAD SYMBOL SKIP IF REAL SYMBOL
00620 JRST PRMAP4 ;IGNORE ZERO NAME(TWOSEG BREAKS)>
00630 IFE REENT!L,<MOVE C,1(A) ;LOAD SYMBOL>
00640 TLNN C,300000 ;TEST FOR LOCAL SYMBOL
00650 JRST .+4 ;GLOBAL (NOT LOCAL ANYWAY)
00660 TRNN F,LOCAFL ;PRINT LOCAL SYMBOLS?
00670 JRST PRMAP4 ;IGNORE LOCAL SYMBOLS
00680 TLC C,040000 ;MAKE IT LOOK LIKE INTERN
00690 TLNE C,040000
00700 JRST PRMP1A
00710 IFN SPCHN,<TRZ N,MAPSUP ;SET MAP NOT SUPPRESSED
00720 SKIPE CHNACB ;TEST FOR SPECIAL CHAINING
00730 TRNN N,CHNMAP ;TEST FOR ROOT MAP PRINTED
00740 JRST PRMP0C ; NO TO EITHER TEST, SKIP AROUND
00750 HRRZ T,2(A) ;GET STARTING ADDRESS
00760 CAML T,BEGOV ;TEST FOR BELOW OVERLAY
00770 JRST PRMP0C ;NO,JUMP
00780 TRO N,MAPSUP ;SUPPRESS IF RE-PRINTING ROOT
00790 JRST PRMAP4 ; & SKIP TO NEXT SYMBOL
00800
00810 PRMP0C:>
00820 PUSHJ P,CRLF
00830 PUSHJ P,CRLF
00840 JRST PRMP1B
00010 PRMP1A:
00020 IFN SPCHN,<TRNE N,MAPSUP ;TEST FOR SUPPRESSED MAP
00030 JRST PRMAP4 ; YES, SKIP THIS SYMBOL>
00040 PUSHJ P,TAB
00050 MOVEI T,40 ;SPACE FOR OPEN GLOBAL
00060 TLNE C,100000 ;LOCAL?
00070 MOVEI T,47 ;YES, TYPE '
00080 TLNE C,400000 ;HALF KILLED TO DDT?
00090 ADDI T,3 ;YES, TYPE # FOR GLOBAL, * FOR LOCAL
00100 PUSHJ P,TYPE2 ;PRINT CHARACTER
00110 PRMP1B: PUSHJ P,PRNAM1 ;PRINT SYMBOL AND VALUE
00120 TLNE C,040000
00130 JRST PRMAP4 ;GLOBAL SYMBOL
00140 HLRE C,W ;POINTER TO NEXT PROG. NAME
00150 HRRZS W ;SO WE ONLY HAVE THE HALF WE WANT
00160 PRMAP7: JUMPL C,PRMP7A
00170 IFN REENT,<SKIPN 1(B) ;IS IT A ZERO SYMBOL
00180 JRST [MOVE C,B ;SET UP C
00190 JRST PRMAP2] ;AND GO
00200 HRRZ T,HVAL ;GET TO OF HI PART
00210 CAML W,HVAL1 ;IS PROGRAM START UP THERE??
00220 JRST PRMAP6 ;YES
00230 HRRZ T,HILOW ;GET HIGHEST LOCATION LOADED IN LOW
00240 SUBI T,(X) ;REMOVE OFFSET
00250 CAIE T,(W) ;EQUAL IF ZERO LENGTH PROG>
00260 HRRZ T,R ;GET LOW, HERE ON LAST PROG
00270 JRST PRMAP6 ;GO
00280
00290 PRMP7A: ADDI C,2(A) ;POINTER TO NEXT PROGRAM NAME
00300 PRMAP2: IFN REENT,<
00310 SKIPE 1(C) ;THIS IS A TWO SEG FILE
00320 JRST PRMP2A ;NO
00330 MOVE T,2(C) ;GET PROG BREAKS
00340 TLNN T,-1 ;IF NO HIGH STUFF YET
00350 HLL T,SVBRKS ;FAKE IT
00360 SUB T,SVBRKS ;SUBTRACT LAST BREAKS
00370 HRRZ W,T ;LOW BREAK
00380 PUSH P,T ;SAVE T
00390 PUSHJ P,PRNUM ;PRINT IT
00400 POP P,T ;RESTORE
00410 HLRZ W,T ;GET HIGH BREAK
00420 JUMPE W,.+3 ;SKIP IF NO HIGH CODE
00430 PUSHJ P,TAB ;AND TAB
00440 PUSHJ P,PRNUM
00450 MOVE T,2(C)
00460 CAMN C,B ;EQUAL IF LAST PROG
00470 SETZ C, ;SIGNAL END
00480 TLNN T,-1
00490 HLL T,SVBRKS
00500 IFE TENEX,<CAMN T,SVBRKS ;ZERO LENGTH IF EQUAL
00510 JRST PRMP6A ;SEE IF LIST ALL ON>
00520 MOVEM T,SVBRKS ;SAVE FOR NEXT TIME
00530 JRST PRMAP3 ;AND CONTINUE
00540 PRMP2A:>
00550 HRRZ T,(C) ;GET ITS STARTING ADRESS
00560 PRMAP6: SUBM T,W ;SUBTRACT ORIGIN TO GET LENGTH
00570 PUSHJ P,PRNUM ;PRINT PROGRAM LENGTH
00580 PUSHJ P,CRLF
00590 PRMP6A:
00600 IFE TENEX,<TLNN N,ALLFLG ;SKIP IF LIST ALL MODE IS ON
00610 TRNE W,777777 ;SKIP IF ZERO LENGTH PROGRAM>
00620 IFN TENEX,<TLNE N,ALLFLG ;SKIP IF LIST ALL MODE IS ON>
00630 JRST PRMAP3
00640 HLRE C,2(A) ;GET BACK CORRECT LOCATION IF 0 LENGTH
00650 JUMPE C,PRMAP5 ;JUMP IF LAST PROGRAM
00660 ADDI C,2(A) ;IN CASE WE SKIPPED SOME PROGRAMS
00670 SKIPA A,C ;SKIP GLOBALS, ZERO LENGTH PROG.
00680 PRMAP3: PUSHJ P,CRLF
00690 PRMAP4: CAILE A,(B) ;TEST FOR END OF SYMBOL TABLE
00700 JRST PRMAP1
00710 PRMAP5: PUSHJ P,CRLF ;GIVE AN XTRA CR-LF
00720 IFN SPCHN,<SKIPN CHNACB ;TEST FOR SPECIAL CHAINING
00730 JRST PMS ;NO, SKIP
00740 TRO N,CHNMAP ;YES, SHOW ROOT-PHASE PRINTED
00750 JRST PMS4 ; & EXIT>
00760 IFN TENEX,<JRST PMS ;GO PRINT UNDEFINED GLOBALS>
00770
00010 SUBTTL LIST UNDEFINED AND MULTIPLY DEFINED GLOBALS
00020
00030 ;LIST UNDEFINED GLOBALS
00040
00050 PMSQ:
00060 IFN TENEX,<SETZM NLSTGL ;ALLOW UNDEFINED GLOBALS TO LIST>
00070 PMS: PUSHJ P,FSCN1 ;LOAD FILES FIRST
00080 JUMPGE S,PMS4 ;JUMP IF NO UNDEFINED GLOBALS
00090 IFN TENEX,<SKIPE NLSTGL ;HAVE UNDEF GLOBALS BEEN LISTED?
00100 POPJ P,0 ;YES
00110 SETOM NLSTGL ;PREVENT IT FROM HAPPENING AGAIN>
00120 PUSHJ P,FCRLF ;START THE MESSAGE
00130 HLRE W,S ;COMPUTE NO. OF UNDEF. GLOBALS
00140 MOVMS W
00150 LSH W,-1 ;<LENGTH OF LIST>/2
00160 PUSHJ P,RCNUMW ;PRINT AS DECIMAL NUMBER
00170 ERROR 7,</UNDEFINED GLOBAL(S)@/>
00180 MOVE A,S ;LOAD UNDEF. POINTER
00190 PMS2: SKIPL W,1(A)
00200 TLNN W,40000
00210 JRST PMS2A
00220 PUSHJ P,FCRLF
00230 PUSHJ P,PRNAM0 ;PRINT SYMBOL AND POINTER
00240 PMS2A: ADD A,SE3
00250 JUMPL A,PMS2
00260 PUSHJ P,CRLF ;NEW LINE
00270
00280 ;LIST NUMBER OF MULTIPLY DEFINED GLOBALS
00290
00300 PMS3: SKIPN W,MDG ;ANY MULTIPLY DEFINED GLOBALS
00310 JRST PMS4 ;NO, EXCELSIOR
00320 PUSHJ P,FCRLF ;ROOM AT THE TOP
00330 PUSHJ P,RCNUMW ;NUMBER OF MULTIPLES IN DECIMAL
00340 ERROR 7,<?MULTIPLY DEFINED GLOBAL(S)@?>
00350 PMS4: TLNE N,AUXSWE ;AUXILIARY OUTPUT DEVICE?
00360 OUTPUT 2, ;INSURE A COMPLETE BUFFER
00370 CPOPJ: POPJ P, ;RETURN
00380
00010 SUBTTL ENTER FILE ON AUXILIARY OUTPUT DEVICE
00020
00030 IAD2:
00040 IFN SYMDSW,<TRNE F,LSYMFL ;ALREADY USING AUX DEV FOR LOCAL SYMBOLS?
00050 POPJ P, ;YES, GIVE ERROR RETURN>
00060 PUSH P,A ;SAVE A FOR RETURN
00070 MOVE A,LD5C1 ;GET AUX. DEV.
00080 DEVCHR A, ;GET DEVCHR
00090 TLNN A,4 ;DOES IT HAVE A DIRECTORY
00100 JRST [SKIPN A,DTOUT ;USE OUTPUT NAME IF GIVEN
00110 JRST IAD2C ;FIND A DEFAULT
00120 JRST IAD2A] ;JUST DO ENTER
00130 MOVE A,DTOUT ;GET OUTPUT NAME
00140 CAME A,[SIXBIT /JOBDAT/] ;DON'T USE JOBDAT
00150 JUMPN A,IAD2A ;USE ANYTHING NON-ZERO
00160 MOVSI A,(SIXBIT /DSK/) ;DEFAULT DEVICE
00170 CAMN A,LD5C1 ;IS IT AUX. DEV.
00180 JRST IAD2C ;YES LEAVE WELL ALONE
00190 CLOSE 2, ;CLOSE OLD AUX. DEV.
00200 MOVEM A,LD5C1 ;SET IT TO DSK
00210 OPEN 2,OPEN2 ;OPEN IT FOR DSK
00220 JRST IMD4 ;FAILED
00230 IAD2C: IFN NAMESW,<
00240 SKIPN A,CURNAM ;USE PROG NAME>
00250 MOVSI A,(SIXBIT /MAP/) ;AN UNLIKELY NAME
00260 MOVEM A,DTOUT ;SO ENTER WILL NOT FAIL
00270 IAD2A:
00280 IFN SPCHN,<MOVE A,CHNOUT+1 ;GET SP CHAIN DEV.
00290 CAMN A,LD5C1 ;IS IT SAME AS AUX. DEV.
00300 SKIPN CHNACB ;YES, ARE WE DOING SP CHAIN?
00310 JRST IAD2B ;NO, PHEW!
00320 DEVCHR A, ;IS IT REALLY A DSK?
00330 TLNE A,DSKBIT
00340 JRST IAD2B ;YES, LEAVE ALONE
00350 RELEAS 2, ;NO, CLEAR OUT ANY RESIDUAL FILE
00360 JRST IMD4 ;AWAY BEFORE SOMETHING TERRIBLE HAPPENS
00370 IAD2B:>
00380 POP P,A ;RECOVER A
00390 SETZM DTOUT+2 ;CLEAR PROTECTION (LEVEL D)
00400 ENTER 2,DTOUT ;WRITE FILE NAME IN DIRECTORY
00410 JRST IMD3 ;NO MORE DIRECTORY SPACE
00420 AOS (P) ;SKIP RETURN IF SUCCESSFUL
00430 POPJ P,
00440
00450 IMD3: ERROR ,</ERROR WRITING FILE@/>
00460 TLZ N,AUXSWE!AUXSWI ;CLEAR AUX DEVICE SWITCHES
00470 JRST LD2
00480
00490 IMD4: MOVE P,PDLPT ;RESTORE STACK
00500 AOBJN P,.+1 ;BUT SAVE RETURN ADDRESS
00510 TLZ N,AUXSWE!AUXSWI ;NO AUX.DEV.NOW
00520 ERROR ,</NO MAP DEVICE@/>
00530 JRST PRMAP5 ;CONTINUE TO LOAD
00540
00010 SUBTTL MONLOD - DISK IMAGE MONITOR LOADER CODE
00020
00030 IFN MONLOD,<
00040
00050 DIOPEN: PUSH P,A ;SAVE AC A
00060 PUSH P,H ;SAVE AC H
00070 PUSH P,N ;SAVE 3 ACC'S
00080 PUSH P,X ;IN A BLOCK
00090 MOVE A,ILD1 ;GET DEVICE
00100 MOVE N,A ;SPARE COPY
00110 DEVCHR A, ;SEE WHAT IT IS
00120 TLNN A,DSKBIT ;IS IT SOME SORT OF DSK?
00130 SKIPA N,DIN1 ;NO, GET THE DEFAULT DEVICE (DSK)
00140 MOVEM N,DIN1 ;YES, OBEY USER AND USE IT
00150 MOVE A,[3,,N] ;SET UP BLOCK
00160 DSKCHR A, ;WAS DSK, BUT SEE IF GENERIC "DSK"
00170 JRST USEDSK ;NO POINT GOING THROUGH WITH THIS
00180 TLNE A,(7B17) ;IS IT GENERIC DSK?
00190 JRST USEDSK ;NO USE WHATS IN DIN1
00200 SETOB N,H ;REQUEST FIRST F/S
00210 MOVE A,[3,,N] ;SET UP A AGAIN
00220 JOBSTR A, ;GET FIRST F/S IN SEARCH LIST
00230 JRST USEDSK ;LEVEL C
00240 JUMPL H,USEDSK ;SWP BIT SET
00250 TLNN H,200000 ;IS NO CREATE BIT SET?
00260 JRST USEDSK ;NO, GENERIC 'DSK' WILL USE THIS F/S
00270 DSKCHR A, ;GET FIRST 3 ARGS
00280 JRST USEDSK ;SHOULD NEVER HAPPEN BUT !!
00290 TLNN A,740200 ;RHB!OFL!HWP!SWP!NNA SET?
00300 CAIGE X,DALLOC ;ENOUGH SPACE?
00310 JRST USEDSK ;CANNOT USE FASTEST F/S
00320 MOVEM N,DIN1 ;USE F/S RATHER THAN 'DSK'
00330 MOVEM N,GENERI ;SAVE F/S INCASE ENTER FAILS
00340 USEDSK: POP P,X ;RESTORE ACC'S
00350 POP P,N
00360 MOVE H,(P) ;RESET H
00370 USDSK2: OPEN 4,OPEN4 ;OPEN DEVICE 'DSK', MODE 16
00380 HALT .-1 ;ERROR, NON-INTELIGENT INDICATION
00390 MOVEM W,DIOUT1+1 ;STORE EXTENSION 'XPN'
00400 MOVE A,DTIN ;GET FILE NAME
00410 MOVEM A,DIOUT1 ;STORE IN 'LOOKUP-ENTER' BLOCK
00420 SETZM DIOUT1+2 ;CLEAR PARAMETERS TO BE SUPPLIED BY MONITOR
00430 SETZM DIOUT1+3 ;ALWAYS USE THIS JOB'S PROJ-PROG NUMBER
00440 SETZM DIOUT+1 ;SAME AGAIN
00450 MOVE A,[17,,11] ;STATES WORD
00460 GETTAB A, ;GET IT
00470 JRST .+3 ;FAILED, NOT LEVEL D FOR SURE
00480 TLNE A,(7B9) ;TEST FOR LEVEL D
00490 TDZA A,A ;YES, THIS IS LEVEL D
00500 MOVEI A,2 ;NOT LEVEL D
00510 ENTER 4,DIOUT(A) ;CREATE OR SUPERCEDE SAVE FILE
00520 JRST ENTFAI ;ERROR, TRY DSK
00530 JUMPE A,LEVELD ;JUMP IF LEVEL D
00540 HRRZ A,.JBREL ;GET CURRENT SIZE
00550 CAIL A,2000 ;NEED AT LEAST 2K
00560 CAILE H,-2000(S) ;CHECK FOR 1K FREE
00570 IFN EXPAND,<JRST [PUSHJ P,XPAND ;GET 1K OF ZEROS, WILL SAVE TIME LATER IN ANYCASE>
00580 JRST FULLC ;NO MORE CORE
00590 IFN EXPAND,< JRST .-1]> ;OK, TRY AGAIN
00600 MOVSI A,-2000 ;FORM IOWD
00610 HRRI A,(H) ;TO 1K OF BLANK
00620 MOVEM A,LOLIST ;STORE IOWD
00630 SETZM LOLIST+1 ;TERMINATE LIST
00640 MOVEI A,DALLOC/10 ;PREALLOCATE THE HARD WAY
00650 OUTPUT 4,LOLIST ;BY DOING OUTPUTS
00660 SOJG A,.-1
00670 MOVEI A,2 ;STILL NOT LEVEL D
00680 LEVELD: CLOSE 4,4 ;WIPE OUT THE OLD FILE IF ONE EXISTS
00690 LOOKUP 4,DIOUT(A) ;LOOKUP FOLLOWED BY ENTER ENABLES UPDATING
00700 HALT .-1 ;ERROR
00710 JUMPN A,ALLOK ;NOT LEVEL D
00720 MOVE A,DIOUT+.RBALC ;SEE WHAT WE GOT
00730 SKIPE GENERI ;IF NOT GENERIC DSK FIRST F/S
00740 CAIL A,DALLOC ;WAS IT ENOUGH
00750 TDZA A,A ;YES, BUT STILL LEVEL D
00760 JRST TRYAGN ;NO JUST USE DSK
00770 ALLOK: ENTER 4,DIOUT(A) ;FILE CAN BE BOTH READ AND WRITTEN
00780 HALT .-1 ;ERROR
00790 MOVE A,H ;GET HIGHEST ADDRESS LOADED SO FAR
00800 SUBI A,-177(X) ;SIZE OF LOW BUFFER MUST BE AN
00810 ANDI A,777600 ;INTEGRAL MULTIPLE OF BLOCK SIZE
00820 MOVEM A,HIRES ;SET UP POINTER FOR LOCATION CHECKING
00830 ADDI A,(X) ;GET ADDRESS OF START OF IMAGE BUFFER
00840 HRRM A,HILIST ;HILIST IS IOWD FOR FILE WINDOW BUFFER
00850 SUBI A,(X) ;A=SIZE OF LOW IMAGE BUFFER (RESIDENT)
00860 MOVN A,A ;GET MINUS BUFFER SIZE
00870 HRLM A,LOLIST ;SET UP WORD COUNT IN LOW IOWD
00880 HRRM X,LOLIST ;ADDRESS FIELD OF IOWD
00890 MOVEM X,XRES ;SAVE OFFSET OF RESIDENT PORTION
00900 MOVE H,HILIST ;GET HIGH BUFFER ADDRESS
00910 MOVNI A,DISIZE ;NEGATIVE SIZE OF FILE WINDOW
00920 HRLM A,HILIST ;SET UP WORD COUNT OF HIGH IOWD
00930 MOVE A,HIRES ;GET HIGHEST ADDRESS IN RESIDENT PORTION+1
00940 LSH A,-7 ;CONVERT TO BLOCK NUMBER
00950 MOVEM A,RESBLK ;STORE NUMBER OF BLOCKS IN RESIDENT PORTION
00960 ADDI H,DISIZE ;H=TOP OF DISK WINDOW BUFFER
00970 MOVEM H,DIEND ;LAST LOCATION IN WINDOW BUFFER+1
00980 CAILE H,1(S) ;SKIP IF SUFFICIENT CORE AVAILABLE
00990 IFN EXPAND,<JRST [PUSHJ P,XPAND>
01000 JRST FULLC
01010 IFN EXPAND,< JRST .-1]>
01020 SOS HILIST ;IOWD POINTS TO BUFFER-1
01030 SOS LOLIST ; "
01040 SETZM HILIST+1 ;TERMINATOR SHOULD BE ZERO
01050 SETZM LOLIST+1 ; "
01060 TLO N,DISW ;SET DISK IMAGE IN USE FLAG
01070 PUSH P,V ;SAVE CURRENT LOADER LOCATION COUNTER
01080 MOVE V,HIRES ;GET FIRST ADDRESS NOT IN RESIDENT BUFFER
01090 PUSHJ P,DICHK2 ;CALL TO INITIALIZE THE BUFFER HANDLER
01100 POP P,V ;RESTORE V
01110 POP P,H ;RESTORE H
01120 SUBI H,(X) ;CONVERT TO ABSOLUTE FOR DISK IMAGE LOAD
01130 POP P,A ;RESTORE AC A
01140 JRST LD2D ;RETURN TO CONTINUE SCAN
01150 DICHK: TLNN N,DISW ;ARE WE DOING A DISK IMAGE LOAD?
01160 POPJ P, ;NO, ALL IS OK
01170 HRRZ X,V ;LEFT HALF OF AC 'V' MAY CONTAIN FLAGS
01180 CAMGE X,HIRES ;SKIP IF ADDRESS NOT IN RESIDENT PORTION
01190 JRST DICHK1 ;ADDRESS IN AC X IS IN RESIDENT PORTION
01200 CAMGE X,DILADD ;SKIP IF ADDRESS ABOVE CORRENT LOWEST WINDOW ADDRESS
01210 JRST DICHK2 ;ADDRESS IS NOT RESIDENT
01220 CAML X,DIHADD ;SKIP IF ADDRESS IS RESIDENT
01230 JRST DICHK2 ;NOT RESIDENT
01240 SKIPA X,XCUR ;GET OFFSET OF CURRENT WINDOW
01250 DICHK1: MOVE X,XRES ;GET OFFSET OF RESIDENT LOW PORTION
01260 POPJ P,
01270
01280 DICHK2: PUSH P,A ;GET ADDRESS IN AC 'V' INTO CORE
01290 PUSH P,Q ;GET SOME AC'S TO WORK WITH
01300 TLZE N,WOSW ;CURRENT BUFFER TO BE WRITTEN OUT?
01310 PUSHJ P,DICHK3 ;YES, GO DO SO
01320 MOVE A,HILIST ;GET ADDRESS-1 OF DISK IMAGE BUFFER
01330 ADDI A,1 ;A NOW POINTS TO START OF BUFFER
01340 SETZM (A) ;CLEAR THE FIRST WORD OF THE BUFFER
01350 MOVS Q,A ;MOVE ADDRESS TO SOURCE FOR BLT
01360 HRRI Q,1(A) ;SOURCE+1 TO DESTINATION
01370 ADDI A,DISIZE ;SET A TO TOP OF BUFFER+1
01380 BLT Q,-1(A) ;CLEAR THE BUFFER
01390 HRRZ Q,V ;GET THE ADDRESS WE'RE LOOKING FOR
01400 SUB Q,HIRES ;ACCOUNT FOR RESIDENT PART
01410 IDIVI Q,DISIZE ;A=Q+1
01420 IMULI Q,DISIZE ;FIRST ADDRESS IN WINDOW
01430 IDIVI Q,↑D128 ;GET BLOCK NUMBER (-NUMBER IN RESIDENT PORTION)
01440 ADD Q,RESBLK ;NUMBER OF RESIDENT BLOCKS
01450 USETI 4,1(Q) ;BLOCK 0 DOES NOT EXIST
01460 STATZ 4,20000 ;END OF FILE?
01470 JRST DICHK4 ;YES, NO SENSE READING
01480 INPUT 4,HILIST ;TRY TO FILL THE DISK IMAGE BUFFER
01490 STATZ 4,740000 ;CHECK FOR ERRORS, DON'T CARE ABOUT EOF
01500 HALT .-3 ;TRY AGAIN ON CONTINUE
01510 DICHK4: MOVEM Q,CURSET ;LEAVE BLOCK NUMBER AROUND FOR LATER USETO
01520 IMULI Q,↑D128 ;GET ADDRESS OF FIRST WORD IN CURRENT BUFFER
01530 MOVEM Q,DILADD ;STORE FOR FUTURE COMPARES
01540 ADDI Q,DISIZE ;ADD SIZE OF DISK IMAGE BUFFER
01550 MOVEM Q,DIHADD ;STORE HIGH CURRENT ADDRESS+1
01560 HRRZ Q,HILIST ;GET WINDOW ADDRESS-1
01570 ADDI Q,1 ;NOW EQUAL TO ADDRESS
01580 SUB Q,DILADD ;COMPUTE LOADER CURRENT WINDOW OFFSET
01590 HRLI Q,V ;SET UP INDEX REGISTER FOR STORED X
01600 MOVEM Q,XCUR ;STORE CURRENT OFFSET
01610 POP P,Q ;RESTORE
01620 POP P,A ;RESTORE
01630 MOVE X,XCUR ;SET UP LOADER OFFSET REGISTER
01640 POPJ P, ;RETURN, ADDRESS IN 'V' NOW RESIDENT
01650
00010 DICHK3: MOVE Q,CURSET ;GET BLOCK NUMBER FOR USETO
00020 USETO 4,1(Q) ;THERE IS NO BLOCK 0
00030 OUTPUT 4,HILIST ;WRITE OUT HE IMAGE
00040 STATZ 4,740000 ;ERROR?
00050 HALT .-3 ;YES, TRY AGAIN ON CONTINUE
00060 POPJ P, ;RETURN
00070
00080 SIZCHK: EXCH A,DIEND ;SAVE A, GET END OF BUFFER ADDRESS
00090 AOS (P) ;DEFAULT IS SKIP RETURN
00100 CAIGE A,(S) ;IS SYMBOL TABLE ENCROACHING ON BUFFER?
00110 AOS (P) ;NO,DON'T EXPAND CORE
00120 EXCH A,DIEND ;RESTORE BOTH A AND DIEND
00130 POPJ P, ;RETURN
00140
00150 DISYM: PUSH P,V ;SAVE CURRENT ADDRESS
00160 MOVE V,A ;GET ADDRESS WERE LOOGING FOR
00170 PUSHJ P,DICHK ;MAKE SURE IT IS IN CORE
00180 POP P,V ;RESTORE V
00190 POPJ P, ;RETURN
00200
00210 DIOVER: MOVE X,XRES ;CLEAN UP XPN FILE AND EXIT
00220 MOVE A,.JBFF(X) ;GET LAST ADDRESS LOADER
00230 SUB A,DILADD ;SUBTRACT CURRENT LOW ADDRESS
00240 ADDI A,↑D128 ;ROUND OFF TO NEAREST BLOCK SIZE
00250 ANDI A,777600 ;FOR IOWD
00260 MOVNS A ;NEGATE
00270 HRLM A,HILIST ;PUT IN WINDOW IOWD
00280 PUSHJ P,DICHK3 ;OUTPUT THE SYMBOL TABLE
00290 USETO 4,1 ;SET UP TO OUTPUT RESIDENT PART
00300 OUTPUT 4,LOLIST ;AND DO SO
00310 STATZ 4,740000 ;ERROR CHECK
00320 HALT .-3 ;IF ERROR TRY AGAIN
00330 CLOSE 4,
00340 EXIT
00350
00360 TRYAGN: PUSH P,DIOUT1 ;SAVE NAME
00370 SETZM DIOUT1
00380 RENAME 4,DIOUT(A) ;GET RID OF FILE
00390 POP P,DIOUT1 ;RESTORE NAME
00400 ENTFAI: SKIPN GENERI ;GENERIC DSK?
00410 HALT . ;NO, JUST GIVE UP
00420 MOVSI A,'DSK' ;TRY WITH JUST DSK
00430 MOVEM A,DIN1
00440 SETZM GENERI
00450 SETZM DIOUT+.RBALC
00460 JRST USDSK2 ;TRY AGAIN
00470
00480
00490 >
00010 SUBTTL PRINT SUBROUTINES
00020
00030 ;PRINT THE 6 DIGIT OCTAL ADDRESS IN W
00040
00050 ; ACCUMULATORS USED: D,T,V
00060
00070 PRNAM0: MOVE C,1(A) ;LOAD SYMBOL
00080 PRNAM1: MOVE W,2(A) ;LOAD VALUE
00090 PRNAM: PUSHJ P,PRNAME
00100 PRNUM:
00110 TRNN F,TTYFL
00120 PUSHJ P,SP1
00130 PUSHJ P,SP1
00140 PRNUM0: MOVE V,PRNUM2 ;LOAD BYTE POINTER TO RH. OF W
00150 MOVNI D,6 ;LOAD CHAR. COUNT
00160 PRNUM1: ILDB T,V ;LOAD DIGIT TO BE OUTPUT
00170 ADDI T,60 ;CONVERT FROM BINARY TO ASCII
00180 PUSHJ P,TYPE2
00190 AOJL D,PRNUM1 ;JUMP IF MORE DIGITS REMAIN
00200 POPJ P,
00210
00220 PRNUM2: POINT 3,W,17 ;BYTE POINTER FOR OCTAL CONVERSION OF W
00230
00240 ;HERE TO LEFT JUSTIFY V, COUNT IN IN Q
00250 LSH V,3 ;STEP LEFT ONE
00260 SHFTL: TLNN V,700000 ;LEFT JUSTIFIED?
00270 SOJGE Q,.-2 ;NO SHIFT IF STILL IN FIELD
00280 JUMPLE Q,CPOPJ ;NOTHING IN THIS FIELD
00290 JRST CPOPJ1 ;SKIP RTETURN, AT LEAST ONE CHAR
00300
00310 ;HERE TO OUTPUT CHARACTERS LEFT AFTER SHIFTING LEFT
00320 OUTVER: SETZ T, ;CLEAR T TO REMOVE JUNK
00330 LSHC T,3 ;SHIFT IN FROM T
00340 ADDI T,(D) ;EITHER "0" OR "A"
00350 PUSHJ P,TYPE2 ;PRINT
00360 SOJG Q,OUTVER ;MORE?
00370 POPJ P, ;NO
00010
00020 IFN NAMESW,<
00030 LDNAM: MOVE T,[POINT 6,CURNAM] ;POINTER
00040 SETZM CURNAM ;CLEAR OLD NAME INCASE FEWER CHARS. IN NEW
00050 MOVNI D,6 ;SET COUNT
00060 TLZ W,740000 ;REMOVE CODE BITS
00070 SETNAM: IDIVI W,50 ;CONVERT FROM RAD 50
00080 HRLM C,(P)
00090 AOJGE D,.+2
00100 PUSHJ P,SETNAM
00110 HLRZ C,(P)
00120 JUMPE C,INAM
00130 ADDI C,17
00140 CAILE C,31
00150 ADDI C,7
00160 CAIG C,72 ;REMOVE SPECIAL CHARS. (. $ %)
00170 IDPB C,T
00180 INAM: POPJ P, >
00190
00200
00210 ;SPECIAL ENTRY POINT WITH NUMBER IN REGISTER W, FALLS THRU TO RCNUM
00220 RCNUMW: MOVE Q,W ;COPY NUMBER INTO PROPER REGISTER
00230
00240 ;YE OLDE RECURSIVE NUMBER PRINTER
00250 ;PRINTS Q, WITH LEADING ZEROES SUPPRESSED; USES A AND T
00260
00270 RCNUM: IDIVI Q,12 ;RADIX DECIMAL
00280 ADDI A,"0"
00290 HRLM A,(P)
00300 JUMPE Q,.+2
00310 PUSHJ P,RCNUM
00320 HLRZ T,(P)
00330 JRST TYPE2
00340
00350
00360 SPACES: PUSHJ P,SP1
00370 SP1: PUSHJ P,SPACE
00380 SPACE: MOVEI T,40
00390 JRST TYPE2
00010 ; ACCUMULATORS USED: Q,T,D
00020
00030 PWORD: MOVNI Q,6 ;SET CHARACTER COUNT TO SIX
00040 PWORD1: MOVE D,LSTPT ;ENTER HERE WITH Q PRESET
00050 PWORD2: ILDB T,D ;LOAD NEXT CHAR. TO BE OUTPUT
00060 PUSHJ P,TYPE ;OUTPUT CHARACTER
00070 AOJL Q,PWORD2
00080 POPJ P,
00090
00100
00110 ;TYPEOUT SUBROUTINE - THE CHARACTER SUPPLIED IN T IS CONVERTED TO ASCII
00120 ;AND IS OUTPUT ON THE CONSOLE AND/OR THE SPECIFIED LOADER MAP OUTPUT
00130 ;DEVICE
00140
00150 CRLFLF: PUSHJ P,CRLF
00160 FCRLF: TLO F,FCONSW ;INSURE TTY OUTPUT
00170 CRLF: SETZM TABCNT ;RESET TAB COUNT ON NEW LINE
00180 MOVEI T,15 ;CARRIAGE RETURN LINE FEED
00190 PUSHJ P,TYPE2
00200 TRCA T,7 ;CR.XOR.7=LF
00210 TYPE: MOVEI T,40(T) ;CONVERT SIXBIT TO ASCII
00220 TYPE2: TLNN N,AUXSWI ;IS THER AN AUXILIARY DEVICE?
00230 JRST TYPE3 ;NO, DONT OUTPUT TO IT
00240 TLOE N,AUXSWE ;IS AUX. DEV. ENTERED?
00250 JRST TYPE2A ; YES, SKIP
00260 PUSHJ P,IAD2 ;NOPE, DO SO!
00270 JRST TYPE3 ;ERROR RETURN
00280 TYPE2A: SOSG ABUF2 ;SPACE LEFT IN BUFFER?
00290 OUTPUT 2, ;CREATE A NEW BUFFER
00300 IDPB T,ABUF1 ;DEPOSIT CHARACTER
00310 IFN RPGSW,<
00320 TRNN F,NOTTTY ;IF TTY IS ANOTHER DEVICE
00330 ;DON'T OUTPUT TO IT>
00340 TLNN F,FCONSW ;FORCE OUTPUT TO CONSOLE TOO?
00350 POPJ P, ;NOPE
00360 TYPE3: SKIPN BUFO2 ;END OF BUFFER
00370 OUTPUT 3, ;FORCE OUTPUT NOW
00380 IDPB T,BUFO1 ;DEPOSIT CHARACTER
00390 CAIN T,12 ;END OF LINE
00400 OUTPUT 3, ;FORCE AN OUTPUT
00410 POPJ P,
00010 SUBTTL SYMBOL PRINT - RADIX 50
00020
00030 ; ACCUMULATORS USED: D,T
00040
00050 PRNAME: MOVE T,C ;LOAD SYMBOL
00060 TLZ T,740000 ;ZERO CODE BITS
00070 CAML T,[50*50*50*50*50] ;SYMBOL LEFT JUSTIFIED
00080 JRST SPT0 ;YES
00090 PUSH P,T
00100 PUSH P,C
00110 MOVEI C,6
00120 MOVEI D,1
00130 IDIVI T,50
00140 JUMPN V,.+2
00150 IMULI D,50
00160 SOJN C,.-3
00170 POP P,C
00180 POP P,T
00190 IMUL T,D
00200 SPT0: MOVNI D,6 ;LOAD CHAR. COUNT
00210 SPT: IDIVI T,50 ;THE REMAINDER IS THE NEXT CHAR.
00220 HRLM V,(P) ;STORE IN LH. OF PUSHDOWN LIST
00230 AOJGE D,.+2 ;SKIP IF NO CHARS. REMAIN
00240 PUSHJ P,SPT ;RECURSIVE CALL FOR NEXT CHAR.
00250 HLRZ T,(P) ;LOAD FROM LH. OF PUSHDOWN LIST
00260 JUMPE T,TYPE ;BLANK
00270 ADDI T,60-1
00280 CAILE T,71
00290 ADDI T,101-72
00300 CAILE T,132
00310 SUBI T,134-44
00320 CAIN T,43
00330 MOVEI T,56
00340 JRST TYPE2
00350
00360 TAB1: PUSHJ P,CRLF
00370 TAB: AOS T,TABCNT
00380 CAIN T,5
00390 JRST TAB1
00400 TLNE N,AUXSWI ;TTY BY DEFAULT?
00410 TRNE F,TTYFL
00420 JRST SP1
00430 MOVEI T,11
00440 JRST TYPE2
00450
00010
00020 OTOD: IBP N
00030 OTOD1: IDIVI Q,↑D10
00040 ADDI Q,20 ;FORM SIXBIT
00050 IDPB Q,N
00060 ADDI A,20
00070 IDPB A,N
00080 POPJ P,
00090
00100 DTAB: SIXBIT /JANFEB/
00110 SIXBIT /MARAPR/
00120 SIXBIT /MAYJUN/
00130 SIXBIT /JULAUG/
00140 SIXBIT /SEPOCT/
00150 SIXBIT /NOVDEC/
00160
00010 SUBTTL ERROR MESSAGE PRINT SUBROUTINE
00020
00030 ; FORM OF CALL:
00040
00050 ; JSP A,ERRPT
00060 ; SIXBIT /<MESSAGE>/
00070
00080 ; ACCUMULATORS USED: T,V,C,W
00090
00100 ERRPT: PUSHJ P,FCRLF ;ROOM AT THE TOP
00110 PUSHJ P,PRQ ;START OFF WITH ?
00120 ERRPT0: PUSH P,Q ;SAVE Q
00130 SKIPA V,ERRPT5
00140 ERRPT1: PUSHJ P,TYPE
00150 ILDB T,V
00160 CAIN T,'@'
00170 JRST ERRPT4
00180 CAIN T,'%'
00190 JRST ERRPT9
00200 CAIN T,'!'
00210 JRST ERRP42 ;JUST RETURN,LEAVE FCONSW ON
00220 CAIE T,'#'
00230 JRST ERRPT1
00240 SKIPN C,DTIN
00250 JRST ERRPT4
00260 MOVNI Q,14
00270 MOVEI W,77
00280 ERRPT2: TDNE C,W
00290 JRST ERRPT3
00300 LSH W,6
00310 AOJL Q,ERRPT2
00320 ERRPT3: MOVE W,ERRPT6
00330 PUSHJ P,PWORD1
00340 SKIPN W,DTIN1
00350 JRST ERRPT4
00360 LSH W,-6
00370 TLO W,160000
00380 MOVNI Q,4
00390 PUSHJ P,PWORD1
00400 ERRPT4: PUSHJ P,CRLF
00410 ERRP41: TLZ F,FCONSW ;ONE ERROR PER CONSOLE
00420 ERRP42: POP P,Q ;***DMN*** FIX FOR ILC MESSAGE
00430 AOJ V, ;PROGRAM BUMMERS BEWARE:
00440 JRST @V ;V HAS AN INDEX OF A
00450
00460 ERRPT5: POINT 6,0(A)
00470 ERRPT6: SIXBIT / FILE /
00010 ERRPT8: PUSHJ P,PRQ ;START WITH ?
00020 CAIGE T,140 ;IS IT A NON-PRINTING CHAR?
00030 CAIL T,40
00040 JRST ERRP8
00050 PUSH P,T
00060 MOVEI T,136 ;UP ARROW
00070 PUSHJ P,TYPE2
00080 POP P,T
00090 TRC T,100 ;CONVERT TO PRINTING CHAR.
00100 ERRP8: PUSHJ P,TYPE2
00110 ERRPT7: PUSHJ P,SPACE
00120 JRST ERRPT0
00130
00140 ERRPT9: MOVEI V,@V
00150 PUSH P,V
00160 ERROR 7,<?ILLEGAL -LOADER@?>
00170 POP P,V
00180 JRST ERRP41
00190
00200 ;PRINT QUESTION MARK
00210
00220 PRQ: PUSH P,T ;SAVE
00230 TLO F,FCONSW ;FORCE TTY OUTPUT ON ANY ERROR
00240 MOVEI T,"?" ;PRINT ?
00250 PUSHJ P,TYPE2 ;...
00260 POP P,T ;RESTORE
00270 POPJ P, ;RETURN
00010 SUBTTL INPUT - OUTPUT INTERFACE
00020
00030 ;BINARY INPUT SUBROUTINE - RETURNS A WORD IN W
00040 WORDPR: PUSHJ P,WORD ;GET FIRST WORD OF PAIR
00050 MOVE C,W ;KEEP IT HANDY
00060 WORD: SOSGE BUFR2 ;SKIP IF BUFFER NOT EMPTY
00070 JRST WORD2
00080 WORD1: ILDB W,BUFR1 ;PICK UP 36 BIT WORD
00090 POPJ P,
00100
00110 WORD2: IN 1, ;GET NEXT BUFFER LOAD
00120 JRST WORD ;DATA OK - CONTINUE LOADING
00130 WORD3: STATZ 1,IODEND ;TEST FOR EOF
00140 JRST EOF ;END OF FILE EXIT
00150 ERROR ,< /INPUT ERROR#/>
00160 JRST LD2 ;GO TO ERROR RETURN
00170
00180
00190 SE3: XWD 2,2 ;SYMBOL POINTER INCREMENT
00200 PDLPT: IOWD PDLSIZ,PDLST ;INITIAL PUSHDOWN STACK
00210 COMM: SQUOZE 0,.COMM.
00220 LSTPT: POINT 6,W ;CHARACTER POINTER TO W
00230
00240 IOBKTL==40000
00250 IOIMPM==400000
00260 IODERR==200000
00270 IODTER==100000
00280 IODEND==20000
00290
00300 IOBAD==IODERR!IODTER!IOBKTL!IOIMPM
00310
00010 SUBTTL IMPURE CODE
00020 IFN PURESW,< RELOC
00030 LOWCOD: RELOC
00040 HICODE:
00050 PHASE LOWCOD>
00060
00070
00080 DBUF1: JSP A,ERRPT7
00090 DBUF: SIXBIT /TI:ME DY-MON-YR @/
00100 POPJ P,
00110
00120 ;DATA FOR PURE OPEN UUO'S
00130
00140 IFN SPCHN,<
00150 CHNENT: 0
00160 SIXBIT .CHN.
00170 0
00180 0
00190 CHNOUT: EXP 16
00200 SIXBIT /DSK/
00210 0
00220 >
00230 IFN RPGSW,<
00240 OPEN1: EXP 1
00250 RPG1: Z
00260 XWD 0,CTLIN
00270 >
00280
00290 OPEN2: EXP 1
00300 LD5C1: Z
00310 XWD ABUF,0
00320
00330 OPEN3: EXP 14
00340 ILD1: Z
00350 XWD 0,BUFR
00360
00370 IFN MONLOD,<
00380 OPEN4: EXP 16
00390 DIN1: SIXBIT /DSK/
00400 Z
00410 >
00420
00430 IFN PURESW,<DEPHASE
00440 CODLN==.-HICODE>
00010 SUBTTL DATA STORAGE
00020
00030 IFN PURESW,< RELOC
00040 LOWCOD: BLOCK CODLN>
00050 DATBEG:! ;STORAGE AREA CLEARED FROM HERE ON INITIALIZATION
00060 ZBEG:! ;CLEARED FROM HERE TO ZEND ON REINITIALIZATION
00070 MDG: BLOCK 1 ;COUNTER FOR MUL DEF GLOBALS
00080 IFN REENT,<HILOW: BLOCK 1 ;HIGHEST NON-BLOCK STMT IN LOW SEG>
00090 STADDR: BLOCK 1 ;HOLDS STARTING ADDRESS
00100 IFN KUTSW,<CORSZ: BLOCK 1>
00110 IFN REENT,<VSW: BLOCK 1>
00120 IFN NAMESW,<CURNAM: BLOCK 1>
00130 IFN B11SW,<POLSW: BLOCK 1>
00140 IFN FAILSW,<LINKTB: BLOCK 21>
00150 IFN SPCHN,<CHNACB: BLOCK 1>
00160 ZEND==.-1
00170 PDSAV: BLOCK 1 ;SAVED PUSHDOWN POINTER
00180 COMSAV: BLOCK 1 ;LENGTH OF COMMON
00190 PDLST: BLOCK PDLSIZ
00200
00210 F.C: BLOCK 1
00220 BLOCK 1 ;STORE N HERE
00230 BLOCK 1 ;STORE X HERE
00240 BLOCK 1 ;STORE H HERE
00250 BLOCK 1 ;STORE S HERE
00260 BLOCK 1 ;STORE R HERE
00270 B.C: BLOCK 1
00280
00290 NAMPTR: BLOCK 1 ;POINTER TO PROGRAM NAME
00300 IFN NAMESW,<
00310 PRGNAM: BLOCK 1 ;STORE BINARY FILE NAME-USED TO MAKE SYSTAT MORE MEANINGFUL
00320 >
00330 IFN REENT,<
00340 HIGHX: BLOCK 1
00350 HIGHR: BLOCK 1 ;HOLD X AND R WHILE LOADING LOW SEG PIECES
00360 LOWX: BLOCK 1
00370 HVAL: BLOCK 1 ;ORG OF HIGH SEG>
00380 HVAL1: BLOCK 1 ;ACTUAL ORG OF HIGH SEG
00390 LOWR: BLOCK 1 ;HOLD X AND R WHILE LOADING HISEG PIECES
00400 IFN COBSW,<LOD37.: BLOCK 1>
00410 IFN DMNSW,<KORSP: BLOCK 1>
00420 IFN LDAC,<BOTACS: BLOCK 1>
00430 IFN WFWSW,<VARLNG: BLOCK 1
00440 VARREL: BLOCK 1>
00450 IFN SAILSW,<LIBFLS: BLOCK RELLEN*3
00460 PRGFLS: BLOCK RELLEN*3>
00470 IFN MONLOD,<
00480 HIRES: BLOCK 1 ;HIGHEST RESIDENT LOADED ADDRESS+1
00490 XRES: BLOCK 1 ;DISPLACEMENT OF RESIDENT PORTION OF LOADED IMAGE
00500 XCUR: BLOCK 1 ;DISPLACEMENT OF CURRENT PORTION OF LOADED IMAGE (WINDOW)
00510 DILADD: BLOCK 1 ;LOWEST ADDRESS IN CURRENT WINDOW
00520 DIHADD: BLOCK 1 ;HIGHEST ADDRESS IN CURRENT WINDOW+1
00530 DIEND: BLOCK 1 ;ADDRESS+1 OF TOP OF WINDOW BUFFER
00540 CURSET: BLOCK 1 ;CURRENT USETI/USETO NUMBER
00550 RESBLK: BLOCK 1 ;NUMBER OF BLOCKS IN RESIDENT PORTION
00560 GENERI: BLOCK 1 ;NAME OF CURRENT F/S
00570 >
00580 IFN TENEX,<
00590 NLSTGL: BLOCK 1 ;FLAG INHIBITS MULT. LIST OF UNDEF. GLOBALS>
00600 PT1: BLOCK 1
00610 IFN RPGSW,<
00620 NONLOD: BLOCK 1
00630 SVRPG: BLOCK 1
00640 IFN TEMP,<
00650 TMPFIL: BLOCK 2
00660 TMPFLG: BLOCK 1>
00670 >
00680 OLDDEV: BLOCK 1 ;OLD DEVICE ON LIBRARY SEARCH
00690 LSTDEV: BLOCK 1 ;LAST DEVICE BEFORE THIS ONE
00700 IFN PP,<
00710 PPPN: BLOCK 1 ;PERM PPN
00720 PPN: BLOCK 1 ;TEMP PPN
00730 PPNE: BLOCK 1
00740 PPNV: BLOCK 1
00750 PPNW: BLOCK 1
00760 IFN SFDSW,<MYPPN: BLOCK 1 ;HOLD USER'S PPN
00770 SFDADD: BLOCK 2 ;DEVICE AND SCAN SWITCH
00780 SFD: BLOCK SFDSW+2 ;TEMP SFD BLOCK
00790 PSFDAD: BLOCK 2 ;DEV AND SCAN SWITCH
00800 PSFD: BLOCK SFDSW+2 ;PERM SFD BLOCK>
00810 >
00820 IFN B11SW,<
00830 GLBCNT: BLOCK 1
00840 HDSAV: BLOCK 1
00850 HEADNM: BLOCK 1
00860 LFTHSW: BLOCK 1
00870 OPNUM: BLOCK 1
00880 SVHWD: BLOCK 1
00890 SVSAT: BLOCK 1
00900 PPDB: BLOCK PPDL+1
00910 >
00920 HISTRT: BLOCK 1 ;JOBREL AT START OF LOADING
00930 IFN L,<
00940 LSPXIT: BLOCK 1
00950 RINITL: BLOCK 1
00960 OLDJR: BLOCK 1>
00970 IFN SPCHN,<
00980 LINKNR: BLOCK 1 ;CURRENT OVERLAY LINK NUMBER
00990 CHNTAB: BLOCK 1 ;CHAIN VECTOR TABLE,, NEXT BLOCK
01000 BEGOV: BLOCK 1 ;RELATIVE ADDRESS OF BEGINNING OF OVERLAY
01010 CHNACN: BLOCK 1 ;RELATIVE POINTER FOR SAVED NAMPTR
01020 >
01030 TABCNT: BLOCK 1
01040 LIMBO: BLOCK 1 ;WHERE OLD CHARS. ARE STORED
01050 IFN DIDAL,<LSTBLK: BLOCK 1 ;POINTER TO LAST PROG LOADED>
01060 IFN EXPAND,<ALWCOR: BLOCK 1 ;CORE AVAILABLE TO USER>
01070 IFN ALGSW,<%OWN: BLOCK 1 ;ADDRESS OF ALGOL OWN AREA
01080 OWNLNG: BLOCK 1 ;LENGTH OF OWN BLOCK>
01090 IFN REENT,<SVBRKS: BLOCK 1 ;XWD HIGH,LOW (PROG BREAKS)>
01100 IFN FORSW,<FORLIB: BLOCK 1 ;0=LIB40,1=FOROTS>
00010 SUBTTL BUFFER HEADERS AND HEADER HEADERS
00020
00030 BUFO: BLOCK 1 ;CONSOLE INPUT HEADER HEADER
00040 BUFO1: BLOCK 1
00050 BUFO2: BLOCK 1
00060
00070 BUFI: BLOCK 1 ;CONSOLE OUTPUT HEADER HEADER
00080 BUFI1: BLOCK 1
00090 BUFI2: BLOCK 1
00100
00110 ABUF: BLOCK 1 ;AUXILIARY OUTPUT HEADER HEADER
00120 ABUF1: BLOCK 1
00130 ABUF2: BLOCK 1
00140
00150 BUFR: BLOCK 1 ;BINARY INPUT HEADER HEADER
00160 BUFR1: BLOCK 1
00170 BUFR2: BLOCK 1
00180
00190 DTIN: BLOCK 1 ;DECTAPE INPUT BLOCK
00200 DTIN1: BLOCK 3
00210
00220 DTOUT: BLOCK 1 ;DECTAPE OUTPUT BLOCK
00230 DTOUT1: BLOCK 3
00240
00250 IFN MONLOD,<
00260 DIOUT:
00270 IFE PURESW,<EXP .RBALC ;DISK IMAGE INPUT/OUTPUT BLOCK>
00280 IFN PURESW,<BLOCK 1>
00290 BLOCK 1
00300 DIOUT1: BLOCK .RBEST-2 ;BIG WASTE OF SPACE IN ORDER TO PRE ALLOCATE SOME DISK
00310 IFE PURESW,<EXP DALLOC ;PRE ALLOCATE SOME BLOCKS>
00320 IFN PURESW,<BLOCK 1> ;.RBEST
00330 BLOCK 1 ;.RBALC
00340 >
00350
00360 TTY1: BLOCK TTYL ;TTY BUFFER AREA
00370 BUF1: BLOCK BUFL ;LOAD BUFFER AREA
00380 AUX: BLOCK ABUFL ;AUX BUFFER AREA
00390
00400 IFN MONLOD,<
00410 LOLIST: BLOCK 2 ;IOLIST FOR LOW PART OF IMAGE
00420 HILIST: BLOCK 2 ;IOLIST FOR HIGH (VIRTUAL) PART OF LOADED IMAGE
00430 >
00440
00450 IFN RPGSW,<
00460 CTLIN: BLOCK 3
00470 CTLNAM: BLOCK 3
00480 CTLBUF: BLOCK 203+1
00490 >
00010 SUBTTL FORTRAN DATA STORAGE
00020
00030 IFN STANSW,<PATCH: BLOCK 20 ;STANFORD HAS SEMI-INFINITE CORE>
00040 SBRNAM: BLOCK 1
00050
00060 IFE K,<
00070 TOPTAB: BLOCK 1 ;TOP OF TABLES
00080 CTAB: BLOCK 1; COMMON
00090 ATAB: BLOCK 1; ARRAYS
00100 STAB: BLOCK 1; SCALARS
00110 GSTAB: BLOCK 1; GLOBAL SUBPROGS
00120 AOTAB: BLOCK 1; OFFSET ARRAYS
00130 CCON: BLOCK 1; CONSTANTS
00140 PTEMP: BLOCK 1; PERMANENT TEMPS
00150 TTEMP: BLOCK 1; TEMPORARY TEMPS
00160 IFN SPCHN,<
00170 SAVBAS: BLOCK 1 ;HIGHEST RELATIVE ADDRESS IN PROGRAM>
00180 COMBAS: BLOCK 1; BASE OF COMMON
00190 LLC: BLOCK 1; PROGRAM ORIGIN
00200 BITP: BLOCK 1; BIT POINTER
00210 BITC: BLOCK 1; BIT COUNT
00220 PLTP: BLOCK 1; PROGRAMMER LABEL TABLE
00230 MLTP: BLOCK 1; MADE LABEL TABLE
00240 SDS: BLOCK 1 ;START OF DATA STATEMENTS
00250 SDSTP: BLOCK 1 ;START OF DATA STATEMENTS POINTER
00260 BLKSIZ: BLOCK 1; BLOCK SIZE
00270 MODIF: BLOCK 1; ADDRESS MODIFICATION +1
00280 SVFORH: BLOCK 1 ;SAVE H WHILE LOADING F4 PROGRAMS
00290
00300 IOWDPP: BLOCK 2
00310 CT1: BLOCK 1 ;TEMP FOR C
00320 LTC: BLOCK 1
00330 ITC: BLOCK 1
00340 ENC: BLOCK 1
00350 WCNT: BLOCK 1 ;DATA WORD COUNT
00360 RCNT: BLOCK 1 ;DATA REPEAT COUNT
00370
00380 LTCTEM: BLOCK 1 ;TEMP FOR LTC
00390 DWCT: BLOCK 1 ;DATA WORD COUNT
00400 IFN MANTIS,<MNTSYM: BLOCK 1 ;HOLDS MANTIS AUX SYMBOL POINTER>
00410 >
00420
00430
00440 VAR ;DUMP VARIABLES
00450 DATEND:! ;END OF AREA CLEARED ON INITIALIZATION
00460 IFN PURESW,<RELOC>
00470
00010 SUBTTL REMAP UUO
00020
00030 IFN PURESW,<HHIGO: PHASE BUF1 ;DON'T NEED BUF1 NOW>
00040
00050 HIGO: CORE V, ;CORE UUO
00060 JFCL ;NEVER FAILS
00070 HINOGO:
00080 IFN REENT,<MOVE D,HVAL ;GET CURRENT HIGH SEG TOP
00090 CAMG D,HVAL1 ;ANYTHING LOADED IN HI-SEG
00100 JRST HIRET ;NO
00110 SUB D,HVAL1 ;SEE HOW MUCH
00120 TRNE D,1777 ;JUST CROSSED A K BOUND?
00130 JRST HIOK ;NO
00140 HRRZ V,D ;LENGTH ONLY
00150 ADD V,HISTRT ;PLUS BASE
00160 CAMGE V,.JBREL ;WE MIGHT HAVE GOT 1K EXTRA
00170 CORE V,
00180 JFCL
00190 HIOK: MOVE V,HISTRT ;NOW REMAP THE HISEG.
00200 REMAP V, ;REMAP UUO.
00210 JRST REMPFL ;FATAL ERROR.>
00220 HIRET: IFN NAMESW,<
00230 IFE TENEX,<MOVE W,CURNAM ;GET PROGRAM NAME>
00240 IFN TENEX,<SKIPA W,.+1
00250 '(PRIV)'>
00260 SETNAM W, ;SET IT FOR VERSION WATCHING>
00270 JRST 0 ;EXECUTE CODE IN ACC'S
00280
00290 IFN REENT,<
00300 REMPFL: TTCALL 3,SEGMES ;PRINT SEGMES
00310 EXIT ;AND DIE
00320 SEGMES: ASCIZ /?REMAP FAILURE/
00330
00340
00350 >
00360 IFN PURESW,<HIGONE: DEPHASE>
00010 SUBTTL LISP LOADER
00020
00030 ;END HERE IF 1K LOADER REQUESTED.
00040 IFN K,<IFE L,<END BEG>
00050
00060 IFN L,< XLIST ;THE LITERALS
00070 LIT ;MUST DUMP NOW SO THEY GET OUTPUT
00080 LIST
00090
00100 LODMAK: MOVEI A,LODMAK
00110 MOVEM A,137 ;SET UP TO SAVE THE LISP LOADER
00120 INIT 17
00130 SIXBIT /DSK/
00140 0
00150 HALT
00160 ENTER LMFILE
00170 HALT
00180 OUTPUT LMLST
00190 STATZ 740000
00200 HALT
00210 RELEASE
00220 EXIT
00230 LMFILE: SIXBIT /LISP/
00240 SIXBIT /LOD/
00250 0
00260 0
00270 LMLST: IOWD 1,.+1 ;IOWD
00280 IOWD LODMAK-LD+1,137 ;AND CORE IMAGE
00290 0
00300 END LODMAK>>
00310
00010 SUBTTL FORTRAN FOUR LOADER
00020
00030 F4LD: TLNE F,SKIPSW!FULLSW ;ARE WE IN SKIP MODE
00040 JRST REJECT ;YES,DON'T LOAD ANY OF THIS
00050 MOVEI W,-2(S); GENERATE TABLES
00060 CAIG W,(H) ;NEED TO EXPAND?
00070 IFN EXPAND,<PUSHJ P,[PUSHJ P,XPAND
00080 POPJ P,
00090 JRST POPJM3]>
00100 IFE EXPAND,< TLO F,FULLSW>
00110 TLO N,F4SW; SET FORTRAN FOUR FLAG
00120 HRRZ V,R; SET PROG BREAK INTO V
00130 MOVEM V,LLC; SAVE FIRST WORD ADDRESS
00140 HRRZM W,MLTP; MADE LABELS
00150 HRRZM W,PLTP; PROGRAMMER LABELS
00160 ADD W,[POINT 1,1]; GENERATE BIT-BYTE POINTER
00170 MOVEM W,BITP
00180 MOVEM W,SDSTP; FIRST DATA STATEMENT
00190 AOS SDSTP;
00200 HRREI W,-↑D36; BITS PER WORDUM
00210 MOVEM W,BITC; BIT COUNT
00220 PUSHJ P,BITWX ;MAKE SURE OF ENOUGH SPACE
00230 MOVE W,[JRST ALLOVE] ;LAST DATA STATEMENT
00240 MOVEM W,(S)
00250
00260 TEXTR: PUSHJ P,WORD; TEXT BY DEFAULT
00270 HLRZ C,W
00280 CAIN C,-1
00290 JRST HEADER; HEADER
00300 MOVEI C,1; RELOCATABLE
00310 TLNN F,FULLSW!SKIPSW ;DON'T LOAD IF EITHER SET
00320 PUSHJ P,BITW; SHOVE AND STORE
00330 JRST TEXTR; LOOP FOR NEXT WORD
00340
00350 ABS: SOSG BLKSIZ; MORE TO GET
00360 JRST TEXTR; NOPE
00370 ABSI: PUSHJ P,WORD;
00380 MOVEI C,0; NON-RELOCATABLE
00390 TLNN F,FULLSW!SKIPSW ;DON'T LOAD IF EITHER SET
00400 PUSHJ P,BITW; TYPE 0
00410 JRST ABS
00010 SUBTTL PROCESS TABLE ENTRIES
00020
00030 MDLB: TLNE F,FULLSW+SKIPSW; MADE LABEL PROC
00040 JRST GLOBDF; NO ROOM AT THE IN
00050 HLRZ C,MLTP; GET PRESENT SIZE
00060 CAMGE C,BLKSIZ; IF NEW SIZE BIGGER, STR-R-RETCH
00070 PUSHJ P,SMLT
00080 HRRZ C,MLTP; GET BASE
00090 MLPLC: ADD C,BLKSIZ; MAKE INDEX
00100 TLNN F,FULLSW+SKIPSW; DONT LOAD
00110 HRRZM V,(C); PUT AWAY DEFINITION
00120 GLOBDF: PUSHJ P,WORD
00130 TLNE F,FULLSW+SKIPSW ;SKIPPING THIS PROG?
00140 JRST TEXTR ;YES, DON'T DEFINE
00150 MOVEI C,(V); AND LOC
00160 EXCH W,C
00170 PUSHJ P,SYMXX; PUT IN DDT-SYMBOL TABLE
00180 PUSHJ P,BITWX
00190 JRST TEXTR
00200
00210 PLB: TLNE F,FULLSW+SKIPSW
00220 JRST GLOBDF
00230 HLRZ C,PLTP; PRESENT SIZE
00240 CAMGE C,BLKSIZ
00250 PUSHJ P,SPLT
00260 HRRZ C,PLTP
00270 JRST MLPLC
00010 SUBTTL STORE WORD AND SET BIT TABLE
00020
00030 BITW: MOVEM W,@X; STORE AWAY OFFSET
00040 IDPB C,BITP; STORE BIT
00050 AOSGE BITC; STEP BIT COUNT
00060 AOJA V,BITWX; SOME MORE ROOM LEFT
00070 HRREI C,-↑D36; RESET COUNT
00080 MOVEM C,BITC
00090 SOS PLTP
00100 SOS BITP; ALL UPDATED
00110 IFE EXPAND,<HRL C,MLTP
00120 SOS MLTP
00130 HRR C,MLTP>
00140 IFN EXPAND,<HRRZ C,MLTP; TO ADDRESS
00150 SUBI C,1
00160 CAIG C,(H)
00170 PUSHJ P,[PUSHJ P,XPAND
00180 POPJ P,
00190 ADDI C,2000
00200 JRST POPJM2]
00210 SOS MLTP
00220 HRLI C,1(C)>
00230 HRRZ T,SDSTP; GET DATA POINTER
00240 BLT C,-1(T); MOVE DOWN LISTS
00250 AOJ V,; STEP LOADER LOCATION
00260 BITWX: IFN REENT,<
00270 TLNE F,HIPROG
00280 JRST FORTHI>
00290 CAIGE H,@X
00300 MOVEI H,@X ;KEEP H SET RIGHT FOR HISEG STUFF
00310 BITWX2: HRRZ T,MLTP
00320 CAIG T,(H); OVERFLOW CHECK
00330 IFE EXPAND,<TLO F,FULLSW>
00340 IFN EXPAND,<PUSHJ P, [PUSHJ P,XPAND
00350 POPJ P,
00360 JRST POPJM3]>
00370 POPJ P,;
00380
00390 SMLT: SUB C,BLKSIZ; STRETCH
00400 MOVS W,MLTP ;LEFT HALF HAS OLD BASE
00410 ADD C,MLTP ;RIGHT HALF HAS NEW BASE
00420 IFN EXPAND,< HRRZS C ;GET RID OF COUNT
00430 CAIG C,(H)
00440 PUSHJ P,[PUSHJ P,XPAND
00450 POPJ P,
00460 ADD W,[XWD 2000,0]
00470 ADDI C,2000
00480 JRST POPJM2]>
00490 HRRM C,MLTP ;PUT IN NEW MLTP
00500 HLL C,W ;FORM BLT POINTER
00510 ADDI W,(C) ;LAST ENTRY OF MLTP
00520 HRL W,BLKSIZ ;NEW SIZE OF MLTP
00530 HLLM W,MLTP ;...
00540 SLTC: BLT C,0(W); MOVE DOWN (UP?)
00550 POPJ P,;
00560
00570 SPLT: SUB C,BLKSIZ
00580 MOVS W,MLTP;
00590 ADDM C,PLTP
00600 ADD C,MLTP
00610 IFN EXPAND,< HRRZS C
00620 CAIG C,(H)
00630 PUSHJ P,[PUSHJ P,XPAND
00640 POPJ P,
00650 ADD W,[XWD 2000,0]
00660 ADDI C,2000
00670 JRST POPJM2]>
00680 HRRM C,MLTP ;PUT IN NEW MLTP
00690 HLL C,W
00700 HLRZ W,PLTP ;OLD SIZE OF PL TABLE
00710 ADD W,PLTP ;NEW BASE OF PL TABLE
00720 HRL W,BLKSIZ ;NEW SIZE OF PL TABLE
00730 HLLM W,PLTP ;INTO POINTER
00740 JRST SLTC
00750
00760
00770 IFN REENT,<
00780 FORTHI: HRRZ T,.JBREL ;CHECK FOR CORE OVERFLOW
00790 CAIGE T,@X
00800 PUSHJ P,[PUSHJ P,HIEXP
00810 POPJ P,
00820 JRST POPJM3] ;CHECK AGAIN
00830 JRST BITWX2>
00010 SUBTTL PROCESS END CODE WORD
00020
00030 ENDS: PUSHJ P,WORD; GET STARTING ADDRESS
00040 JUMPE W,ENDS1; NOT MAIN
00050 ADDI W,(R); RELOCATION OFFSET
00060 TLNE N,ISAFLG; IGNORE STARTING ADDRESS
00070 JRST ENDS1
00080 HRRZM W,STADDR ;STORE STARTING ADDRESS
00090 IFN NAMESW,<MOVE W,NAMPTR ;GET POINTER
00100 MOVE W,1(W) ;SET UP NAME
00110 PUSHJ P,LDNAM
00120 MOVE W,DTIN
00130 MOVEM W,PRGNAM>
00140 ENDS1: PUSHJ P,WORDPR ;DATA STORE SIZE
00150 HRRZM C,PTEMP ;NUMBER OF PERMANENT TEMPS
00160 MOVEM V,CCON; START OF CONSTANTS AREA
00170 JUMPE W,E1; NULL
00180 MOVEM W,BLKSIZ ;SAVE COUNT
00190 MOVEI W,0(V) ;DEFINE CONST.
00200 MOVE C,CNR50 ;...
00210 TLNN F,SKIPSW!FULLSW
00220 PUSHJ P,SYMPT ;...
00230 PUSHJ P,GSWD ;STORE CONSTANT TABLE
00240 E1: MOVEI W,0(V); GET LOADER LOC
00250 EXCH W,PTEMP; STORE INTO PERM TEMP POINTER
00260 ADD W,PTEMP; FORM TEMP TEMP ADDRESS
00270 MOVEM W,TTEMP; POINTER
00280 MOVEM V,GSTAB; STORE LOADER LOC IN GLOBSUB
00290 MOVEM H,SVFORH
00300 MOVE C,TTR50 ;DEFINE %TEMP.
00310 TLNE F,SKIPSW!FULLSW
00320 JRST E1A
00330 PUSHJ P,SYMPT ;...
00340 MOVE C,PTR50 ;DEFINE (IF EXTANT) TEMP.
00350 MOVEI W,0(V) ;...
00360 CAME W,TTEMP ;ANY PERM TEMPS?
00370 PUSHJ P,SYMPT ;YES, DEFINE
00380 E1A: PUSHJ P,WORD; NUMBER OF GLOBSUBS
00390 JUMPE W,E11
00400 MOVEM W,BLKSIZ ;SIZE OF GLOBSUB
00410 PUSHJ P,GSWD ;STORE GLOBSUB TABLE
00420 E11: MOVEM V,STAB; SCALARS
00430 PUSHJ P,WORD; HOW MANY?
00440 JUMPE W,E21; NONE
00450 PUSHJ P,GSWDPR ;STORE SCALAR TABLE
00460 E21: MOVEM V,ATAB; ARRAY POINTER
00470 PUSHJ P,WORD; COMMENTS FOR SCALARS APPLY
00480 JUMPE W,E31
00490 PUSHJ P,GSWDPR ;STORE ARRAY TABLE
00500 E31: MOVEM V,AOTAB; ARRAYS OFFSET
00510 PUSHJ P,WORD; SAME COMMENTS AS ABOVE
00520 JUMPE W,E41
00530 PUSHJ P,GSWDPR ;STORE ARRAY OFFSET TABLE
00540 E41: PUSHJ P,WORD; TEMP, SCALAR, ARRAY SIZE
00550 TLNE F,FULLSW!SKIPSW ;SKIPPING THIS PROG?
00560 MOVEI W,0 ;DON'T ACCEPT GLOB SUBPROG REQUESTS
00570 MOVEM V,CTAB; SETUP COMMON TABLE POINTER
00580 ADD W,GSTAB; GLOBAL SUBPROG BASE
00590 MOVEM W,COMBAS; START OF COMMON
00600 IFN SPCHN,<MOVEM W,SAVBAS ;SAVE AS HIGHEST ADDRESS IN PROGRAM>
00610 PUSHJ P,WORD; COMMON BLOCK SIZE
00620 HRRZM W,BLKSIZ
00630 JUMPE W,PASS2; NO COMMON
00640 COMTOP: PUSHJ P,WORDPR ;GET A COMMON PAIR
00650 TLNE F,SKIPSW!FULLSW ;IF SKIPPING
00660 JRST COMCO1 ;DON'T USE
00670 PUSHJ P,SDEF; SEARCH
00680 JRST COMYES; ALREADY THERE
00690 HRLS W
00700 HRR W,COMBAS; PICK UP THIS COMMON LOC
00710 TLNN F,SKIPSW!FULLSW
00720 PUSHJ P,SYMXX; DEFINE IT
00730 MOVS W,W; SWAP HALFS
00740 ADD W,COMBAS; UPDATE COMMON LOC
00750 HRRM W,COMBAS; OLD BASE PLUS NEW SIZE
00760 HLRZS W; RETURN ADDRESS
00770 TLZ C,400000
00780 TLNN F,SKIPSW!FULLSW
00790 PUSHJ P,SYMXX
00800 COMCOM: PUSHJ P,CWSTWX ;STORE A WORD PAIR
00810 COMCO1: SOS BLKSIZ
00820 SOSLE BLKSIZ
00830 JRST COMTOP
00840 JRST PASS2
00850
00860 COMYES: HLRZ C,2(A); PICK UP DEFINITION
00870 CAMLE W,C; CHECK SIZE
00880 JRST ILC; ILLEGAL COMMON
00890 MOVE C,1(A); NAME
00900 HRRZ W,2(A); BASE
00910 JRST COMCOM
00010
00020 PRSTWX: PUSHJ P,WORDPR ;GET A WORD PAIR
00030 CWSTWX: EXCH C,W ;SPACE TO STORE FIRST WORD OF PAIR?
00040 PUSHJ P,WSTWX ;...
00050 EXCH C,W ;THERE WAS; IT'S STORED
00060 WSTWX: TLNE F,FULLSW!SKIPSW ;SPACE FOR ANOTHER WORD?
00070 POPJ P, ;NOPE, RETURN
00080 MOVEM W,@X ;YES, STORE IT.
00090 AOJA V,BITWX ;TELL THE TABLES ABOUT IT; THEN RETURN
00100
00110
00120 GSWD: PUSHJ P,WORD ;GET WORD FROM TABLE
00130 PUSHJ P,WSTWX ;STASH IT
00140 SOSE BLKSIZ ;FINISHED?
00150 JRST GSWD ;NOPE, LOOP
00160 POPJ P, ;TRA 1,4
00170
00180 GSWDPR: MOVEM W,BLKSIZ ;KEEP COUNT
00190 GSWDP1: PUSHJ P,PRSTWX ;GET AND STASH A PAIR
00200 SOS BLKSIZ ;FINISHED?
00210 SOSLE BLKSIZ ;...
00220 JRST GSWDP1 ;NOPE, LOOP
00230 POPJ P, ;TRA 1,4
00010 SUBTTL BEGIN HERE PASS2 TEXT PROCESSING
00020
00030 PASS2: ADDI V,(X)
00040 IFN REENT,<TLNE F,HIPROG
00050 HRRZ V,H>
00060 MOVEM V,TOPTAB ;SAVE FOR OVERLAP CHECKING
00070 TLNE F,FULLSW+SKIPSW; ABORT?
00080 JRST ALLOVE; YES
00090 MOVE V,LLC ;PICK UP PROGRAM ORIGIN
00100 CAML V,CCON ;IS THIS A PROGRAM?
00110 JRST FBLKD ;NO, GO LOOK FOR FIRST BLK DATA
00120 IFE L,<IFN REENT,<TLNN F,HIPROG ;DON'T BOTHER IF IN HISEG, CHAIN NOT SMART ENOUGH>
00130 TLOE N,PGM1 ;YES, IS THIS FIRST F4 PROG?
00140 JRST NOPRG ;NO
00150 HRR W,COMBAS ;YES, PLACE PROG BREAK IN LH
00160 HRLM W,.JBCHN(X) ;FOR CHAIN>
00170 NOPRG: HRRZ W,PLTP; GET PROG TABLE BASE
00180 HLRZ C,PLTP; AND SIZE
00190 ADD W,C; COMPUTE END OF PROG TABLE
00200 ADD W,[POINT 1,1]; AND BEGINNING OF BIT TABLE
00210 EXCH W,BITP; SWAP POINTERS
00220 PASS2B: ILDB C,BITP; GET A BIT
00230 JUMPE C,PASS2C; NO PASS2 PROCESSING
00240 PUSHJ P,PROC; PROCESS A TAG
00250 JRST PASS2B; MORE TO COME
00260 JRST ENDTP;
00270
00280 PROC: LDB C,[POINT 6,@X,23]; TAG
00290 SETZM MODIF; ZERO TO ADDRESS MODIFIER
00300 TRZE C,40
00310 AOS MODIF
00320 MOVEI W,TABDIS; HEAD OF TABLE
00330 HRLI W,-TABLNG ;SET UP FOR AOBJN
00340 HLRZ T,(W); GET ENTRY
00350 CAME T,C; CHECK
00360 AOBJN W,.-2
00370 JUMPGE W,LOAD4A ;RAN OUT OF ENTRIES
00380 HRRZ W,(W); GET DISPATCH
00390 LDB C,[POINT 12,@X,35]
00400 JRST (W); DISPATCH
00410
00420
00430 PASS2C: PUSHJ P,PASS2A
00440 JRST PASS2B
00450 JRST ENDTP
00010
00020 TABDIS: XWD 11,PCONS; CONSTANTS
00030 XWD 06,PGS; GLOBAL SUBPROGRAMS
00040 XWD 20,PST; SCALARS
00050 XWD 22,PAT; ARRAYS
00060 XWD 01,PATO; ARRAYS OFFSET
00070 XWD 00,PPLT; PROGRAMMER LABELS
00080 XWD 31,PMLT; MADE LABESL
00090 XWD 26,PPT; PERMANENT TEMPORARYS
00100 XWD 27,PTT; TEMPORARY TEMPORARYS
00110 TABLNG==.-TABDIS
00120 ;DISPATCH ON A HEADER
00130
00140 HEADER: CAMN W,[EXP -2]; END OF PASS ONE
00150 JRST ENDS
00160 LDB C,[POINT 12,W,35]; GET SIZE
00170 MOVEM C,BLKSIZ
00180 ANDI W,770000
00190 JUMPE W,PLB; PROGRAMMER LABEL
00200 CAIN W,500000; ABSOLUTE BLOCK
00210 JRST ABSI;
00220 CAIN W,310000; MADE LABEL
00230 JRST MDLB; MADE LABEL
00240 CAIN W,600000
00250 JRST GLOBDF
00260 CAIN W,700000; DATA STATEMENT
00270 JRST DATAS
00280 IFN MANTIS,<CAIN W,770000; SPECIAL DEBUGGER DATA
00290 JRST SPECBUG>
00300 JRST LOAD4A; DATA STATEMENTS WILL GO HERE
00310
00320 TTR50: RADIX50 10,%TEMP.
00330 PTR50: RADIX50 10,TEMP.
00340 CNR50: RADIX50 10,CONST.
00350
00360 IFN MANTIS,<
00370 SPECB: CAML W,.JBREL ;ROOM?
00380 AOJA W,[CORE W, ;NO, GET IT
00390 JRST MORCOR
00400 JRST .+1] ;GOT IT
00410 PUSHJ P,WORD ;GET SPECIAL DATA
00420 MOVEM W,@MNTSYM ;DEPOSIT IT
00430 SOSG BLKSIZ ;MORE?
00440 JRST TEXTR ;NO
00450 SPECBUG:TRNN N,MANTFL ;ARE WE LOADING MANTIS DATA?
00460 JRST [PUSHJ P,WORD ;NO, READ A WORD
00470 SOSG BLKSIZ ;AND IGNORE IT
00480 JRST TEXTR ;BLOCK EXHAUSTED?
00490 JRST @.] ;NO, LOOP
00500 AOS W,MNTSYM ;STEP SPECIAL POINTER
00510 SOJG W,SPECB ;LOOP IF SETUP ALREADY
00520 HRRZ W,.JBREL ;SET IT UP NOW
00530 MOVEM W,MNTSYM
00540 JRST SPECBUG ;AND STEP IT>
00010 SUBTTL ROUTINES TO PROCESS POINTERS
00020
00030 PCONS: ADD C,CCON; GENERATE CONSTANT ADDRESS
00040 SOJA C,PCOMX ;ADJUST FOR 1 AS FIRST ENTRY
00050
00060 PSTA: PUSHJ P,SWAPSY ;NON-COMMON SCALARS AND ARRAYS
00070 ADDI C,(R); RELOCATE
00080 PCOM1: PUSHJ P,SYDEF ;...
00090 PCOMX: ADD C,MODIF ;ADDR RELOC FOR DP
00100 HRRM C,@X; REPLACE ADDRESS
00110 PASS2A: AOJ V,; STEP READOUT POINTER
00120 CAML V,CCON ;END OF PROCESSABLES?
00130 CPOPJ1: AOS (P); SKIP
00140 POPJ P,;
00150
00160 PAT: SKIPA W,ATAB ;ARRAY TABLE BASE
00170 PST: MOVE W,STAB ;SCALAR TABLE BASE
00180 ROT C,1 ;SCALE BY 2
00190 ADD C,W ;ADD IN TABLE BASE
00200 ADDI C,-2(X); TABLE ENTRY
00210 HLRZ W,(C); CHECK FOR COMMON
00220 TRNN W,7777 ;IGNORE SIX BITS ;U/O-LKS
00230 JRST PSTA ;NO COMMON ;U/O-LKS
00240 PUSHJ P,COMDID ;PROCESS COMMON
00250 JRST PCOM1
00260
00270 COMDID: ANDI W,7777 ;IGNORE SIX BITS ;U/O-LKS
00280 LSH W,1 ;PROCESS COMMON TABLE ENTRIES
00290 ADD W,CTAB; COMMON TAG
00300 ADDI W,-2(X); OFFSET
00310 PUSHJ P,SWAPSY; GET SYMBOL AND SET TO DEFINED
00320 ADD C,1(W); BASE OF COMMON
00330 POPJ P, ;RETURN
00340
00350 PATO: ROT C,1
00360 ADD C,AOTAB; ARRAY OFFSET
00370 ADDI C,-2(X); LOADER OFFSET
00380 MOVEM C,CT1; SAVE CURRENT POINTER
00390 HRRZ C,1(C); PICK UP REFERENCE POINTER
00400 ANDI C,7777; MASK TO ADDRESS
00410 ROT C,1; ALWAYS A ARRAY
00420 ADDI C,-2(X)
00430 ADD C,ATAB
00440 HLRZ W,(C); COMMON CHECK
00450 TRNN W,7777 ;IGNORE SIX BITS ;U/O-LKS
00460 JRST NCO ;U/O-LKS
00470 PUSHJ P,COMDID ;PROCESS COMMON
00480 PUSHJ P,SYDEF
00490 MOVE C,CT1
00500 HRRE C,(C)
00510 ADD C,1(W)
00520 JRST PCOMX
00010 NCO: PUSHJ P,SWAPSY;
00020 ADDI C,(R) ;DEFINE SYMBOL IN TRUE LOC
00030 PUSHJ P,SYDEF ;...
00040 MOVE C,CT1
00050 HRRZ C,(C) ;OFFSET ADDRESS PICKUP
00060 ADDI C,(R) ;WHERE IT WILL BE
00070 JRST PCOMX ;STASH ADDR AWAY
00080
00090 PTT: ADD C,TTEMP; TEMPORARY TEMPS
00100 SOJA C,PCOMX ;ADJUST FOR 1 AS FIRST ENTRY
00110
00120 PPT: ADD C,PTEMP; PERMANENT TEMPS
00130 SOJA C,PCOMX ;ADJUST FOR 1 AS FIRST ENTRY
00140
00150 PGS: ADD C,GSTAB; GLOBSUBS
00160 ADDI C,-1(X); OFFSET
00170 MOVE C,(C)
00180 TLC C,640000; MAKE A REQUEST
00190 PUSHJ P,TBLCHK ;CHECK FOR OVERLAP
00200 MOVEI W,(V); THIS LOC
00210 HLRM W,@X; ZERO RIGHT HALF
00220 PUSHJ P,SYMXX
00230 JRST PASS2A
00240
00250 SYDEF: TLNE N,SYDAT ;SYMBOL WANTS DEFININITION?
00260 POPJ P, ;NO, GO AWAY
00270 PUSH P,C ;SAVE THE WORLD
00280 PUSH P,W
00290 PUSHJ P,TBLCHK ;CHECK FOR OVERLAP
00300 MOVE W,C
00310 SKIPE C,T ;PICKUP VALUE
00320 PUSHJ P,SYMXX
00330 POP P,W
00340 POP P,C
00350 POPJ P,;
00360
00370 PMLT: ADD C,MLTP
00380 JRST .+2
00390 PPLT: ADD C,PLTP
00400 HRRZ C,(C)
00410 JRST PCOMX
00420
00430 SYMXX: PUSH P,V
00440 PUSHJ P,SYMPT
00450 POP P,V
00460 IFE REENT,<POPJ P,>
00470 IFN REENT,<JRST RESTRX>
00010
00020 SWAPSY: MOVEI T,0; SET TO EXCHANGE DEFS
00030 EXCH T,1(C); GET NAME
00040 IFN MANTIS,<TRNE N,MANTFL ;LOADING MANTIS DATA?
00050 SKIPA C,(C) ;YES, GET FULLWORD VALUE>
00060 HRRZ C,(C) ;GET HALFWORD VALUE
00070 POPJ P,
00080 TBLCHK: HRRZ W,MLTP ;GETT TOP OV TABLES
00090 SUBI W,2
00100 CAMG W,TOPTAB ;WILL IT OVERLAP
00110 IFE EXPAND,<TLO F,FULLSW>
00120 IFN EXPAND,<JRST [PUSHJ P,XPAND
00130 POPJ P,
00140 JRST TBLCHK]>
00150 POPJ P,
00010 SUBTTL END OF PASS2
00020
00030 ALLOVE: TLZ N,F4SW ;END OF F4 PROG
00040 HRRZ V,SDSTP ;GET READY TO ZERO OUT DATA STMTS
00050 SETZM (V) ;AT LEAST ONE THERE
00060 CAIL V,(S) ;IS THERE MORE THAN ONE??
00070 JRST NOMODS ;NO
00080 HRLS V
00090 ADDI V,1 ;SET UP BLT
00100 BLT V,(S) ;ZERO OUT ALL OF IT
00110 NOMODS: MOVE H,SVFORH
00120 TLNE F,FULLSW!SKIPSW
00130 JRST HIGH3A
00140 HRR R,COMBAS ;TOP OF THE DATA
00150 CAMG H,SDS ;HIGHEST LOC GREATER THAN DATA STATEMENTS?
00160 JRST HIGH3A ;NO, RETURN
00170 ADDI H,1(S) ;YES, SET UP MEANINGFUL ERROR COMMENT
00180 SUB H,SDS ;...
00190 TLO F,FULLSW ;INDICATE OVERFLO
00200 HIGH3A: IFN REENT,<SETZ W, ;CAUSES TROUBLE OTHERWISE
00210 TLZE F,HIPROG
00220 JRST HIGHN1
00230 IFE SPCHN,<HRRZ V,GSTAB>
00240 IFN SPCHN,<HRRZ V,SAVBAS ;GET END OF PROGRAM RELATIVE ADDRESS
00250 ;THIS MEANS THAT WITH SPECIAL CHAINING THE
00260 ;ENTIRE LAST PROGRAM OF A LINK WILL BE SAVED
00270 ;BUT COMMON DECLARED FOR THE FIRST TIME
00280 ;IN THAT PROGRAM WON'T BE. THIS SHOULD NOT
00290 ;CAUSE PROBLEMS BECAUSE IF COMMON APPEARS HERE
00300 ;NOBODY ELSE CAN REFERENCE IT ANYWAY. >
00310 MOVEI V,@X
00320 CAMLE V,HILOW
00330 MOVEM V,HILOW>
00340 HRRZ C,R
00350 JRST HIGH31 ;RETURN
00360
00370 DATAS: TLNE F,FULLSW+SKIPSW
00380 JRST DAX
00390 MOVEI C,(S) ;ADDR OF WORD UNDER SYMBOL TABLE
00400 MOVN W,BLKSIZ ;HOW FAR DOWN TO BLT
00410 ADDM W,PLTP ;UPDATE TABLE POINTERS
00420 ADDM W,BITP ;...
00430 ADDM W,SDSTP ;...
00440 ADD C,W ;RH(C):= WHEN TO STOP BLT
00450 HRL C,MLTP ;SOURCE OF BLTED DATA
00460 ADD W,MLTP ;UPDATE, GET DESTINATION OF BLT DATA
00470 IFN EXPAND,< HRRZS W ;GET RID OF LEFT HALF
00480 CAIG W,(H)
00490 PUSHJ P,[PUSHJ P,XPAND
00500 POPJ P,
00510 ADDI W,2000
00520 ADD C,[XWD 2000,2000]
00530 JRST POPJM2]>
00540 HRRM W,MLTP ;NO SET THIS SO EXTRA CORE NOT ZEROED
00550 HLL W,C ;FORM BLT POINTER
00560 BLT W,-1(C) ;MOVE TABLES DOWN (BUT NOT JRST ALLOVE)
00570 PUSHJ P,BITWX
00580 DAX: PUSHJ P,WORD; READ ONE WORD
00590 TLNN F,FULLSW+SKIPSW
00600 MOVEM W,(C)
00610 SOSLE BLKSIZ ;COUNT OF DATA SEQUENCE SIZE
00620 AOJA C,DAX ;INCREMENT DATA SEQUENCE DEPOSIT LOC
00630 JRST TEXTR; DONE
00010 FBLKD: IFE L,<IFN REENT,<
00020 TLNN F,HIPROG>
00030 TLOE N,BLKD1 ;IS THIS FIRST BLOCK DATA?
00040 JRST ENDTP ;NO
00050 HRR V,COMBAS ;PLACE PROG BREAK IN RH FOR
00060 HRRM V,.JBCHN(X) ;CHAIN>
00070 ENDTP: TLNE F,FULLSW+SKIPSW
00080 JRST ALLOVE
00090 HRR V,GSTAB
00100 ENDTP0: CAML V,STAB; ANY MORE GLOBSUBS
00110 JRST ENDTP2; NO
00120 MOVE C,@X; GET SUBPROG NAME
00130 PUSHJ P,SREQ; IS IT ALLREADY REQUESTED
00140 AOJA V,ENDTP0; YES
00150 PUSHJ P,SDEF; OR DEFINED
00160 AOJA V,ENDTP0; YES
00170 PUSHJ P,TBLCHK
00180 MOVEI W,0 ;PREPARE DUMMY LINK
00190 TLNN F,FULLSW+SKIPSW ;ABORT
00200 PUSHJ P,SYM3X; PUT IN DUMMY REQUEST
00210 PUSHJ P,BITWX; OVERLAP CHECK
00220 AOJA V,ENDTP0
00230 ENDTP2: SETZM PT1
00240 ENDTPW: HRRZ V,SDSTP
00250 IFN EXPAND,<IFN REENT,<TLNE F,HIPROG
00260 JRST ENDTPI>
00270 SUBI V,(X)
00280 CAMG V,COMBAS
00290 PUSHJ P,[SUB V,COMBAS
00300 MOVNS V
00310 JRST XPAND9]
00320 JFCL ;FOR ERROR RETURN FROM XPAND
00330 ENDTPH: HRR V,SDSTP>
00340 HRRZM V,SDS ;DATA STATEMENT LOC
00350 ENDTP1: SUBI V,(X); COMPENSATE FOR OFFSET
00360 MOVE W,@X; GET WORD
00370 TLNE W,-1; NO LEFT HALF IMPLIES COUNT
00380 JRST DODON; DATA DONE
00390 ADD W,[MOVEI W,3]
00400 ADDI W,@X
00410 EXCH W,@X
00420 AOJ V,
00430 ADD W,@X; ITEMS COUNT
00440 MOVEM W,ITC
00450 MOVE W,[MOVEM W,LTC]
00460 MOVEM W,@X; SETUP FOR DATA EXECUTION
00470 AOJ V,
00480 MOVSI W,(MOVEI W,0)
00490 EXCH W,@X
00500 MOVEM W,ENC; END COUNT
00510 AOJ V,
00520 MOVEI W,@X
00530 ADDM W,ITC
00540 LOOP: MOVE W,@X
00550 HLRZ T,W; LEFT HALF INST.
00560 ANDI T,777000
00570 CAIN T,254000 ;JRST?
00580 JRST WRAP ;END OF DATA
00590 CAIN T,260000 ;PUSHJ?
00600 JRST PJTABL(W) ;DISPATCH VIA TABLE
00610 CAIN T,200000; MOVE?
00620 AOJA V,INNER
00630 CAIN T,270000; ADD?
00640 JRST ADDOP
00650 CAIN T,221000; IMULI?
00660 AOJA V,LOOP
00670 CAIE T,220000; IMUL?
00680 JRST LOAD4A; NOTA
00690 INNER: HRRZ T,@X; GET ADDRESS
00700 TRZE T,770000; ZERO TAG?
00710 SOJA T,CONPOL; NO, CONSTANT POOL
00720 JUMPE T,FORCNF
00730 SUB T,PT1; SUBTRACT INDUCTION NUMBER
00740 ASH T,1
00750 SUBI T,1
00760 HRRM T,@X
00770 HLRZ T,@X
00780 ADDI T,P
00790 HRLM T,@X
00800 AOJA V,LOOP
00810 IFN EXPAND,<IFN REENT,<
00820 ENDTPI: HRRZ V,COMBAS
00830 MOVEI V,@X
00840 CAMLE V,.JBREL
00850 JRST [PUSHJ P,HIEXP
00860 JRST ENDTPH
00870 JRST ENDTPI]
00880 JRST ENDTPH>>
00890 FORCNF: ERROR ,</FORTRAN CONFUSED ABOUT DATA STATEMENTS!/>
00900 JRST ILC1
00010 CONPOL: ADD T,ITC; CONSTANT BASE
00020 HRRM T,@X
00030 AOJA V,LOOP
00040
00050 ADDOP: HRRZ T,@X
00060 TRZE T,770000
00070 SOJA T,CONPOL
00080 SKIPIN: AOJA V,LOOP
00090
00100 PJTABL: JRST DWFS ;PUSHJ 17,0
00110 AOSA PT1 ;INCREMENT DO COUNT
00120 SOSA PT1; DECREMENT DO COUNT
00130 SKIPA W,[EXP DOINT.]
00140 MOVEI W,DOEND.
00150 HRRM W,@X
00160 AOJA V,SKIPIN ;SKIP A WORD
00170
00180 DWFS: MOVEI W,DWFS.
00190 HRRM W,@X
00200 AOJ V,
00210 TLO N,SYDAT
00220 PUSHJ P,PROC; PROCESS THE TAG
00230 JUMPGE V,DATAOV ;DATA STATEMENT BELOW CODE TOP
00240 JRST LOOP ;PROPER RETURN
00250
00260 DOINT.: POP P,V; GET ADDRESS OF INITIAL VALUE
00270 PUSH P,(V); STORE INDUCTION VARIABLE
00280 AOJ V,
00290 PUSH P,V; INITIAL ADDRESS
00300 JRST (V)
00310
00320 DOEND.: HLRE T,@(P) ;RETAIN SIGN OF INCREMENT
00330 ADDM T,-2(P); INCREMENT
00340 HRRE T,@(P); GET FINAL VALUE
00350 SUB T,-2(P) ;FINAL - CURRENT
00360 IMUL T,@(P) ;INCLUDE SIGN OF INCREMENT
00370 JUMPL T,DODONE ;SIGN IS ONLY IMPORTANT THING
00380 POP P,(P); BACK UP POINTER
00390 JRST @(P)
00010 DODONE: POP P,-1(P); BACK UP ADDRESS
00020 POP P,-1(P)
00030 JRST CPOPJ1 ;RETURN
00040
00050 WRAP: MOVE W,ENC; NUMBER OF CONSTANTS
00060 ADD W,ITC; CONSTANT BASE
00070 MOVEI C,(W); CHAIN
00080 HRRM C,@X
00090 MOVEI V,(W); READY TO GO
00100 JRST ENDTP1
00110
00120 DODON: TLZ N,RCF!SYDAT!DZER ;DATA STATEMENT FLAGS
00130 MOVE W,PTEMP ;TOP OF PROG
00140 ADDI W,(X) ;+OFFSET
00150 HRRZ C,SDS
00160 IFE EXPAND,<SUBI C,(X) ;CHECK FOR ROOM
00170 CAMGE C,COMBAS ;IS IT THERE
00180 TLO F,FULLSW ;NO (DONE EARLIER IF EXPAND)
00190 HRRZ C,SDS>
00200 SUBI C,1 ;GET ONE LESS (TOP LOCATION TO ZERO)
00210 IFN REENT,<TLNE F,HIPROG
00220 MOVE C,.JBREL>
00230 SECZER: CAMLE W,C ;ANY DATA TO ZERO?
00240 JRST @SDS ;NO, DO DATA STATEMENTS
00250 ;FULLSW IS ON IF COMBAS GT. SDS
00260 TLNN F,FULLSW+SKIPSW ;SHOULD WE ZERO?
00270 SETZM (W) ;YES, DO SO
00280 TLON N,DZER ;GO BACK FOR MORE?
00290 AOJA W,SECZER ;YES, PLEASE
00300 HRLI W,-1(W) ;SET UP BLT POINTER TO ZERO DATA
00310 TLNN F,FULLSW+SKIPSW ;SHOULD WE ZERO?
00320 BLT W,(C) ;YES, DO SO
00330 JRST @SDS ;GO DO DATA STATEMENTS
00340
00350 DATAOV: ERROR 0,</DATA STATEMENT OVERFLOW!/>
00360 JRST ILC1
00010 DREAD: TLNE N,RCF; NEW REPEAT COUNT NEEDED
00020 JRST FETCH; NO
00030 MOVE W,LTC
00040 MOVEM W,LTCTEM
00050 MOVE W,@LTC; GET A WORD
00060 HLRZM W,RCNT; SET REPEAT COUNT
00070 HRRZM W,WCNT; SET WORD COUNT
00080 POP W,(W); SUBTRACT ONE FROM BOTH HALFS
00090 HLLM W,@LTC; DECREMENT REPEAT COUNT
00100 AOS W,LTC; STEP READOUT
00110 TLO N,RCF
00120 FETCH: MOVE W,@LTC
00130 AOS LTC
00140 SOSE WCNT
00150 POPJ P,;
00160 SOSN RCNT
00170 JRST DOFF.
00180 MOVE V,LTCTEM; RESTORE READOUT
00190 MOVEM V,LTC
00200 DOFF.: TLZ N,RCF; RESET DATA REPEAT FLAG
00210 POPJ P,;
00220
00230 DWFS.: MOVE T,(P)
00240 AOS (P)
00250 MOVE T,(T); GET ADDRESS
00260 HLRZM T,DWCT; DATA WORD COUNT
00270 HRRZS T
00280 ADDI T,(W); OFFSET
00290 IFN REENT,<HRRZS T ;CLEAR LEFT HALF INCASE OF CARRY
00300 CAML T,HVAL1
00310 JRST [ADD T,HIGHX
00320 HRRZS T ;MUST GET RID OF LEFT HALF
00330 CAMLE T,.JBREL
00340 JRST DATAOV ;IN CASE FORTRAN GOOFS ON LIMITS
00350 JRST DWFS.1]
00360 ADD T,LOWX>
00370 HRRZS T
00380 IFE REENT,<ADDI T,(X)>
00390 CAML T,SDS
00400 JRST DATAOV
00410 DWFS.1: PUSHJ P,DREAD ;GET A DATA WORD
00420 HRRZS T
00430 IFN REENT,<CAMG T,.JBREL ;JUST TO MAKE SURE>
00440 CAMN T,SDS
00450 JRST DATAOV
00460 TLNN F,FULLSW+SKIPSW ;LOAD THE NEXT DATA ITEM?
00470 MOVEM W,(T) ;YES, STORE IT
00480 SOSE W,DWCT; STEP DOWN AND TEST
00490 AOJA T,DWFS.1 ;ONE MORE TIME, MOZART BABY!
00500 POPJ P,
00010 SUBTTL ROUTINE TO SKIP FORTRAN OUTPUT
00020
00030 ;SUBSECTION OF THE ROUTINE TO HANDLE OUTPUT FROM THE
00040 ;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO
00050 ;LOOK FOR THE END BLOCK. CODE TAKEN FROM FUDGE2.
00060
00070 MACHCD: HRRZ C,W ;GET THE WORD COUNT
00080 PUSHJ P,WORD ;INPUT A WORD
00090 SOJG C,.-1 ;LOOP BACK FOR REST OF THE BLOCK
00100 ;GO LOOK FOR NEXT BLOCK
00110
00120 REJECT: PUSHJ P,WORD ;READ A FORTRAN BLOCK HEADER
00130 TLC W,-1 ;TURN ONES TO ZEROES IN LEFT HALF
00140 TLNE W,-1 ;WAS LEFT HALF ALL ONES?
00150 JRST REJECT ;NO, IT WAS CALCULATED MACHINE CODE
00160 CAIN W,-2 ;YES, IS RIGHT HALF = 777776?
00170 JRST ENDST ;YES, PROCESS F4 END BLOCK
00180 LDB C,[POINT 6,W,23];GET CODE BITS FROM BITS 18-23
00190 TRZ W,770000 ;THEN WIPE THEM OUT
00200 CAIN C,77 ;IS IT SPECIAL DEBUGGER DATA?
00210 JRST MACHCD ;YES, TREAT IT LIKE DATA
00220 CAIE C,70 ;IS IT A DATA STATEMENT?
00230 CAIN C,50 ;IS IT ABSOLUTE MACHINE CODE?
00240 JRST MACHCD ;YES, TREAT IT LIKE DATA STATEMENTS
00250 PUSHJ P,WORD ;NO, ITS A LABEL OF SOME SORT
00260 JRST REJECT ;WHICH CONSISTS OF ONE WORD
00270 ;LOOK FOR NEXT BLOCK HEADER
00280
00290 ENDST: MOVEI C,1 ;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE
00300 MOVEI T,6 ;TO GO
00310 F4LUP1: PUSHJ P,WORD ;GET TABLE MEMBER
00320 F4LUP3: SOJGE C,F4LUP1 ;LOOP WITHIN A TABLE
00330 JUMPL T,LOAD1 ;LAST TABLE - RETURN
00340 SOJG T,F4LUP2 ;FIRST TWO WORDS AND FIVE TABLES
00350 JUMPE T,F4LUP1 ;COMMON LENGTH WORD
00360 F4LUP2: PUSHJ P,WORD ;READ HEADER WORD
00370 MOVE C,W ;COUNT TO COUNTER
00380 JRST F4LUP3 ;STASH
00010 SUBTTL LISP LOADER
00020
00030 IFE L,< END BEG>
00040 IFN L,< XLIST
00050 LIT
00060 LIST
00070
00080 LODMAK: MOVEI A,LODMAK
00090 MOVEM A,137 ;SET UP TO SAVE THE LISP LOADER
00100 INIT 17
00110 SIXBIT /DSK/
00120 0
00130 HALT
00140 ENTER LMFILE
00150 HALT
00160 OUTPUT LMLST
00170 STATZ 740000
00180 HALT
00190 RELEASE
00200 EXIT
00210 LMFILE: SIXBIT /LISP/
00220 SIXBIT /LOD/
00230 0
00240 0
00250 LMLST: IOWD 1,.+1 ;IOWD
00260 IOWD LODMAK-LD+1,137 ;AND CORE IMAGE
00270 0
00280 END LODMAK>